home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / glyphs-x.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-28  |  75.5 KB  |  2,694 lines
  1. /* X-specific Lisp objects.
  2.    Copyright (C) 1993, 1994 Free Software Foundation, Inc.
  3.    Copyright (C) 1995 Board of Trustees, University of Illinois
  4.    Copyright (C) 1995 Tinker Systems
  5.    Copyright (C) 1995 Ben Wing
  6.    Copyright (C) 1995 Sun Microsystems
  7.  
  8. This file is part of XEmacs.
  9.  
  10. XEmacs is free software; you can redistribute it and/or modify it
  11. under the terms of the GNU General Public License as published by the
  12. Free Software Foundation; either version 2, or (at your option) any
  13. later version.
  14.  
  15. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  16. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  17. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  18. for more details.
  19.  
  20. You should have received a copy of the GNU General Public License
  21. along with XEmacs; see the file COPYING.  If not, write to the Free
  22. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  23.  
  24. /* Synched up with: Not in FSF. */
  25.  
  26. /* Original author: Jamie Zawinski for 19.8
  27.    font-truename stuff added by Jamie Zawinski for 19.10
  28.    subwindow support added by Chuck Thompson
  29.    additional XPM support added by Chuck Thompson
  30.    initial X-Face support added by Stig
  31.    rewritten/restructured by Ben Wing for 19.12/19.13 
  32.  */
  33.  
  34. #include <config.h>
  35. #include "lisp.h"
  36.  
  37. #include "device-x.h"
  38. #include "frame-x.h"
  39. #include "glyphs-x.h"
  40. #include "objects-x.h"
  41. #include "xmu.h"
  42.  
  43. #include "buffer.h"
  44. #include "insdel.h"
  45.  
  46. #include "sysfile.h"
  47.  
  48. /* #### This isn't going to be sufficient if we ever want to handle
  49.    multiple screens on a single display. */
  50. #define LISP_DEVICE_TO_X_SCREEN(dev)                    \
  51.   XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev)))
  52.  
  53. DEFINE_IMAGE_INSTANTIATOR_TYPE (xbm);
  54. Lisp_Object Qxbm;
  55.  
  56. Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
  57. Lisp_Object Q_foreground, Q_background;
  58.  
  59. #ifdef HAVE_XPM
  60. DEFINE_IMAGE_INSTANTIATOR_TYPE (xpm);
  61. Lisp_Object Qxpm;
  62. Lisp_Object Q_color_symbols;
  63. #endif
  64.  
  65. #ifdef HAVE_XFACE
  66. DEFINE_IMAGE_INSTANTIATOR_TYPE (xface);
  67. Lisp_Object Qxface;
  68. #endif
  69.  
  70. #ifdef HAVE_JPEG
  71. DEFINE_IMAGE_INSTANTIATOR_TYPE (jpeg);
  72. Lisp_Object Qjpeg;
  73. #endif
  74.  
  75. #ifdef HAVE_PNG
  76. DEFINE_IMAGE_INSTANTIATOR_TYPE (png);
  77. Lisp_Object Qpng;
  78. #endif
  79.  
  80. #ifdef HAVE_GIF
  81. DEFINE_IMAGE_INSTANTIATOR_TYPE (gif);
  82. Lisp_Object Qgif;
  83. #endif
  84.  
  85. DEFINE_IMAGE_INSTANTIATOR_TYPE (autodetect);
  86. Lisp_Object Qautodetect;
  87.  
  88. #include "bitmaps.h"
  89.  
  90.  
  91. /************************************************************************/
  92. /*                      image instance methods                          */
  93. /************************************************************************/
  94.  
  95. static void
  96. x_print_image_instance (struct Lisp_Image_Instance *p,
  97.             Lisp_Object printcharfun,
  98.             int escapeflag)
  99. {
  100.   char buf[100];
  101.  
  102.   switch (IMAGE_INSTANCE_TYPE (p))
  103.     {
  104.     case IMAGE_MONO_PIXMAP:
  105.     case IMAGE_COLOR_PIXMAP:
  106.     case IMAGE_CURSOR:
  107.       sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p));
  108.       write_c_string (buf, printcharfun);
  109.       if (IMAGE_INSTANCE_X_MASK (p))
  110.     {
  111.       sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p));
  112.       write_c_string (buf, printcharfun);
  113.     }
  114.       write_c_string (")", printcharfun);
  115.       break;
  116.     case IMAGE_SUBWINDOW:
  117.       /* #### implement me */
  118.     default:
  119.       break;
  120.     }
  121. }
  122.  
  123. static void
  124. x_finalize_image_instance (struct Lisp_Image_Instance *p)
  125. {
  126.   Screen *scr = LISP_DEVICE_TO_X_SCREEN (IMAGE_INSTANCE_DEVICE (p));
  127.  
  128.   if (!p->data)
  129.     return;
  130.  
  131.   if (IMAGE_INSTANCE_X_PIXMAP (p))
  132.     XFreePixmap (DisplayOfScreen (scr), IMAGE_INSTANCE_X_PIXMAP (p));
  133.   if (IMAGE_INSTANCE_X_MASK (p) &&
  134.       IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p))
  135.     XFreePixmap (DisplayOfScreen (scr), IMAGE_INSTANCE_X_MASK (p));
  136.   IMAGE_INSTANCE_X_PIXMAP (p) = 0;
  137.   IMAGE_INSTANCE_X_MASK (p) = 0;
  138.  
  139.   if (IMAGE_INSTANCE_X_CURSOR (p))
  140.     {
  141.       XFreeCursor (DisplayOfScreen (scr), IMAGE_INSTANCE_X_CURSOR (p));
  142.       IMAGE_INSTANCE_X_CURSOR (p) = 0;
  143.     }
  144.  
  145.   if (IMAGE_INSTANCE_X_NPIXELS (p) != 0)
  146.     {
  147.       XFreeColors (DisplayOfScreen (scr),
  148.            DefaultColormapOfScreen (scr),
  149.            IMAGE_INSTANCE_X_PIXELS (p),
  150.            IMAGE_INSTANCE_X_NPIXELS (p), 0);
  151.       IMAGE_INSTANCE_X_NPIXELS (p) = 0;
  152.     }
  153.   if (IMAGE_INSTANCE_X_PIXELS (p))
  154.     {
  155.       xfree (IMAGE_INSTANCE_X_PIXELS (p));
  156.       IMAGE_INSTANCE_X_PIXELS (p) = 0;
  157.     }
  158.  
  159.   xfree (p->data);
  160.   p->data = 0;
  161. }
  162.  
  163. static int
  164. x_image_instance_equal (struct Lisp_Image_Instance *p1,
  165.             struct Lisp_Image_Instance *p2, int depth)
  166. {
  167.   switch (IMAGE_INSTANCE_TYPE (p1))
  168.     {
  169.     case IMAGE_MONO_PIXMAP:
  170.     case IMAGE_COLOR_PIXMAP:
  171.     case IMAGE_CURSOR:
  172.       if (IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2))
  173.     return 0;
  174.       break;
  175.     case IMAGE_SUBWINDOW:
  176.       /* #### implement me */
  177.       break;
  178.     default:
  179.       break;
  180.     }
  181.  
  182.   return 1;
  183. }
  184.  
  185. static unsigned long
  186. x_image_instance_hash (struct Lisp_Image_Instance *p, int depth)
  187. {
  188.   switch (IMAGE_INSTANCE_TYPE (p))
  189.     {
  190.     case IMAGE_MONO_PIXMAP:
  191.     case IMAGE_COLOR_PIXMAP:
  192.     case IMAGE_CURSOR:
  193.       return IMAGE_INSTANCE_X_NPIXELS (p);
  194.     case IMAGE_SUBWINDOW:
  195.       /* #### implement me */
  196.       return 0;
  197.     default:
  198.       return 0;
  199.     }
  200. }
  201.  
  202.  
  203. /************************************************************************/
  204. /*                  image instance utility functions                    */
  205. /************************************************************************/
  206.  
  207. /* Where bitmaps are; initialized from resource database */
  208. Lisp_Object Vx_bitmap_file_path;
  209.  
  210. #ifndef BITMAPDIR
  211. #define BITMAPDIR "/usr/include/X11/bitmaps"
  212. #endif
  213.  
  214. #define USE_XBMLANGPATH
  215.  
  216. /* Given a pixmap filename, look through all of the "standard" places
  217.    where the file might be located.  Return a full pathname if found;
  218.    otherwise, return Qnil. */
  219.  
  220. static Lisp_Object
  221. locate_pixmap_file (Lisp_Object name)
  222. {
  223.   /* This function can GC if IN_REDISPLAY is false */
  224.   Display *display;
  225.  
  226.   /* Check non-absolute pathnames with a directory component relative to
  227.      the search path; that's the way Xt does it. */
  228.   /* #### Unix-specific */
  229.   if (string_byte (XSTRING (name), 0) == '/' ||
  230.       (string_byte (XSTRING (name), 0) == '.' &&
  231.        (string_byte (XSTRING (name), 1) == '/' ||
  232.     (string_byte (XSTRING (name), 1) == '.' &&
  233.      (string_byte (XSTRING (name), 2) == '/')))))
  234.     {
  235.       if (!NILP (Ffile_readable_p (name)))
  236.     return name;
  237.       else
  238.     return Qnil;
  239.     }
  240.  
  241.   if (NILP (Vdefault_x_device))
  242.     /* This may occur during intialization. */
  243.     return Qnil;
  244.   else
  245.     /* We only check the bitmapFilePath resource on the original X device. */
  246.     display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device));
  247.  
  248. #ifdef USE_XBMLANGPATH
  249.   {
  250.     char *path = egetenv ("XBMLANGPATH");
  251.     SubstitutionRec subs[1];
  252.     subs[0].match = 'B';
  253.     subs[0].substitution = (char *) string_data (XSTRING (name));
  254.     /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set.
  255.        We don't.  If you want it used, set it. */
  256.     if (path &&
  257.     (path = XtResolvePathname (display, "bitmaps", 0, 0, path,
  258.                    subs, XtNumber (subs), 0)))
  259.       {
  260.     name = build_string (path);
  261.     XtFree (path);
  262.         return (name);
  263.       }
  264.   }
  265. #endif
  266.  
  267.   if (NILP (Vx_bitmap_file_path))
  268.     {
  269.       char *type = 0;
  270.       XrmValue value;
  271.       if (XrmGetResource (XtDatabase (display),
  272.               "bitmapFilePath", "BitmapFilePath", &type, &value)
  273.       && !strcmp (type, "String"))
  274.     Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr);
  275.       Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path,
  276.                     (list1 (build_string (BITMAPDIR))));
  277.     }
  278.  
  279.   {
  280.     Lisp_Object found;
  281.     if (locate_file (Vx_bitmap_file_path, name, "", &found, R_OK) < 0)
  282.       {
  283.     Lisp_Object temp = list1 (Vdata_directory);
  284.     struct gcpro gcpro1;
  285.  
  286.     GCPRO1 (temp);
  287.     locate_file (temp, name, "", &found, R_OK);
  288.     UNGCPRO;
  289.       }
  290.  
  291.     return found;
  292.   }
  293. }
  294.  
  295. /* If INST refers to inline data, return Qnil.
  296.    If INST refers to data in a file, return the full filename
  297.    if it exists; otherwise, return t. */
  298.  
  299. static Lisp_Object
  300. potential_pixmap_file_instantiator (Lisp_Object inst,
  301.                     Lisp_Object file_keyword,
  302.                     Lisp_Object data_keyword)
  303. {
  304.   Lisp_Object file;
  305.   Lisp_Object data;
  306.  
  307.   assert (VECTORP (inst));
  308.   
  309.   data = find_keyword_in_vector (inst, data_keyword);
  310.   file = find_keyword_in_vector (inst, file_keyword);
  311.  
  312.   if (!NILP (file) && NILP (data))
  313.     {
  314.       Lisp_Object retval = locate_pixmap_file (file);
  315.       if (!NILP (retval))
  316.     return retval;
  317.       else
  318.     return Qt; /* should have been file */
  319.     }
  320.  
  321.   return Qnil;
  322. }
  323.  
  324. static void
  325. x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii)
  326. {
  327.   ii->data = malloc_type_and_zero (struct x_image_instance_data);
  328.   IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
  329.   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil;
  330.   IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil;
  331.   IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = 0;
  332.   IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = 0;
  333.   IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = 0;
  334.   IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil;
  335.   IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil;
  336. }
  337.  
  338. /* Check that this server supports cursors of this size. */
  339. static int
  340. check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height,
  341.              Lisp_Object instantiator, int no_error)
  342. {
  343.   unsigned int best_width, best_height;
  344.   if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs),
  345.               width, height, &best_width, &best_height))
  346.     /* #### What does it mean when XQueryBestCursor() returns 0?
  347.        I can't find that documented anywhere. */
  348.     best_width = best_height = 0;
  349.  
  350.   if (width > best_width || height > best_height)
  351.     {
  352.       if (!no_error)
  353.     {
  354.       char buf [255];
  355.       sprintf (buf, "cursor too large (%dx%d): "
  356.            "server requires %dx%d or smaller",
  357.            width, height, best_width, best_height);
  358.       signal_error (Qerror, list2 (build_string (buf), instantiator));
  359.     }
  360.       return 0;
  361.     }
  362.  
  363.   return 1;
  364. }
  365.  
  366.  
  367. /**********************************************************************
  368.  *                             XBM                                    *
  369.  **********************************************************************/
  370.  
  371. /* Check if DATA represents a valid inline XBM spec (i.e. a cons
  372.    of (width height bits), with checking done on the dimensions).
  373.    If so, return 1.  If not, return 0 if NO_ERROR is non-zero;
  374.    otherwise, signal an error. */
  375.  
  376. static int
  377. valid_xbm_inline_p (Lisp_Object data, int no_error)
  378. {
  379.   Lisp_Object width, height, bits;
  380.  
  381.   if (!CONSP (data))
  382.     {
  383.       if (!no_error)
  384.     CHECK_CONS (data, 0);
  385.       return 0;
  386.     }
  387.   if (!CONSP (XCDR (data)) || !CONSP (XCDR (XCDR (data))) ||
  388.       !NILP (XCDR (XCDR (XCDR (data)))))
  389.     {
  390.       if (!no_error)
  391.     signal_simple_error ("Must be list of 3 elements", data);
  392.       return 0;
  393.     }
  394.  
  395.   width = XCAR (data);
  396.   height = XCAR (XCDR (data));
  397.   bits = XCAR (XCDR (XCDR (data)));
  398.  
  399.   if (!INTP (width) || !INTP (height) || !STRINGP (bits))
  400.     {
  401.       if (!no_error)
  402.     signal_simple_error ("Must be (width height bits)",
  403.                  vector3 (width, height, bits));
  404.       return 0;
  405.     }
  406.  
  407.   if (XINT (width) <= 0)
  408.     {
  409.       if (!no_error)
  410.     signal_simple_error ("Width must be > 0", width);
  411.       return 0;
  412.     }
  413.  
  414.   if (XINT (height) <= 0)
  415.     {
  416.       if (!no_error)
  417.     signal_simple_error ("Height must be > 0", height);
  418.       return 0;
  419.     }
  420.  
  421.   if (((unsigned) (XINT (width) * XINT (height)) / 8)
  422.       > string_length (XSTRING (bits)))
  423.     {
  424.       if (!no_error)
  425.     signal_simple_error ("data is too short for W and H",
  426.                  vector3 (width, height, bits));
  427.       return 0;
  428.     }
  429.  
  430.   return 1;
  431. }
  432.  
  433. /* Validate method for XBM's. */
  434.  
  435. static int
  436. xbm_validate (Lisp_Object instantiator, int no_error)
  437. {
  438.   return file_or_data_must_be_present (instantiator, no_error);
  439. }
  440.  
  441. /* Given a filename that is supposed to contain XBM data, return
  442.    the inline representation of it as (width height bits).  Return
  443.    the hotspot through XHOT and YHOT, if those pointers are not 0.
  444.    If there is no hotspot, XHOT and YHOT will contain -1.
  445.  
  446.    If the function fails:
  447.  
  448.    -- if OK_IF_DATA_INVALID is set and the data was invalid,
  449.       return Qt.
  450.    -- if NO_ERROR is set, return Qnil.
  451.    -- otherwise, signal an error.
  452.  */
  453.    
  454.  
  455. static Lisp_Object
  456. bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot, int no_error,
  457.              int ok_if_data_invalid)
  458. {
  459.   unsigned int w, h;
  460.   Bufbyte *data;
  461.   int result;
  462.  
  463.   result = XmuReadBitmapDataFromFile ((char *) string_data (XSTRING (name)),
  464.                       &w, &h, &data, xhot, yhot);
  465.  
  466.   if (result == BitmapSuccess)
  467.     {
  468.       Lisp_Object retval;
  469.       int len = (w + 7) / 8 * h;
  470.  
  471.       retval = list3 (make_number (w), make_number (h),
  472.               make_string (data, len));
  473.       XFree ((char *) data);
  474.       return retval;
  475.     }
  476.  
  477.   switch (result)
  478.     {
  479.     case BitmapOpenFailed:
  480.       {
  481.     if (!no_error)
  482.       /* should never happen */
  483.       signal_double_file_error ("Opening bitmap file",
  484.                     "no such file or directory",
  485.                     name);
  486.     break;
  487.       }
  488.     case BitmapFileInvalid:
  489.       {
  490.     if (ok_if_data_invalid)
  491.       return Qt;
  492.     if (!no_error)
  493.       signal_double_file_error ("Reading bitmap file",
  494.                     "invalid data in file",
  495.                     name);
  496.     break;
  497.       }
  498.     case BitmapNoMemory:
  499.       {
  500.     if (!no_error)
  501.       signal_double_file_error ("Reading bitmap file",
  502.                     "out of memory",
  503.                     name);
  504.     break;
  505.       }
  506.     default:
  507.       {
  508.     if (!no_error)
  509.       signal_double_file_error_2 ("Reading bitmap file",
  510.                       "unknown error code",
  511.                       make_number (result), name);
  512.     break;
  513.       }
  514.     }
  515.  
  516.   return Qnil;
  517. }
  518.  
  519. /* Normalize method for XBM's. */
  520.  
  521. static Lisp_Object
  522. xbm_normalize (Lisp_Object inst, Lisp_Object device_type, int no_error)
  523. {
  524.   Lisp_Object file = Qnil, mask_file = Qnil;
  525.   struct gcpro gcpro1, gcpro2, gcpro3;
  526.   Lisp_Object alist = Qnil;
  527.   
  528.   GCPRO3 (file, mask_file, alist);
  529.  
  530.   /* Now, convert any file data into inline data for both the regular
  531.      data and the mask data.  At the end of this, `data' will contain
  532.      the inline data (if any) or Qnil, and `file' will contain
  533.      the name this data was derived from (if known) or Qnil.
  534.      Likewise for `mask_file' and `mask_data'.
  535.  
  536.      Note that if we cannot generate any regular inline data, we
  537.      skip out. */
  538.  
  539.   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data);
  540.   mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
  541.                           Q_mask_data);
  542.  
  543.   if (EQ (file, Qt)) /* failure locating filename */
  544.     {
  545.       if (!no_error)
  546.     signal_double_file_error ("Opening bitmap file",
  547.                   "no such file or directory",
  548.                   file);
  549.       RETURN_UNGCPRO (Qnil);
  550.     }
  551.  
  552.   if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
  553.     RETURN_UNGCPRO (inst);
  554.  
  555.   alist = tagged_vector_to_alist (inst);
  556.  
  557.   if (!NILP (file))
  558.     {
  559.       int xhot, yhot;
  560.       Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, no_error, 0);
  561.       if (NILP (data)) /* conversion failure; error should
  562.                   already be signalled. */
  563.     RETURN_UNGCPRO (Qnil);
  564.       alist = remassq_no_quit (Q_file, alist);
  565.       /* there can't be a :data at this point. */
  566.       alist = Fcons (Fcons (Q_file, file),
  567.              Fcons (Fcons (Q_data, data), alist));
  568.  
  569.       if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
  570.     alist = Fcons (Fcons (Q_hotspot_x, make_number (xhot)),
  571.                alist);
  572.       if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
  573.     alist = Fcons (Fcons (Q_hotspot_y, make_number (yhot)),
  574.                alist);
  575.     }
  576.  
  577.   if (!NILP (mask_file))
  578.     {
  579.       Lisp_Object mask_data =
  580.     bitmap_to_lisp_data (mask_file, 0, 0, no_error, 0);
  581.       alist = remassq_no_quit (Q_mask_file, alist);
  582.       /* there can't be a :mask-data at this point. */
  583.       alist = Fcons (Fcons (Q_mask_file, mask_file),
  584.              Fcons (Fcons (Q_mask_data, mask_data), alist));
  585.     }
  586.  
  587.   {
  588.     Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
  589.     free_alist (alist);
  590.     RETURN_UNGCPRO (result);
  591.   }
  592. }
  593.  
  594. /* Given inline data for a mono pixmap, create and return the
  595.    corresponding X object. */
  596.  
  597. static Pixmap
  598. pixmap_from_xbm_inline (Lisp_Object device, int width, int height,
  599.             char *bits)
  600. {
  601.   Screen *screen = LISP_DEVICE_TO_X_SCREEN (device);
  602.   return XCreatePixmapFromBitmapData (DisplayOfScreen (screen),
  603.                       RootWindowOfScreen (screen),
  604.                       bits, width, height,
  605.                       1, 0, 1);
  606. }
  607.  
  608. /* Given inline data for a mono pixmap, initialize the given
  609.    image instance accordingly. */
  610.  
  611. static int
  612. init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii,
  613.                      int width, int height,
  614.                      unsigned char *bits,
  615.                      Lisp_Object instantiator,
  616.                      int dest_mask,
  617.                      Pixmap mask,
  618.                      Lisp_Object mask_filename,
  619.                      int no_error)
  620. {
  621.   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
  622.   Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground);
  623.   Lisp_Object background = find_keyword_in_vector (instantiator, Q_background);
  624.   Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device));
  625.   Screen *scr = DefaultScreenOfDisplay (dpy);
  626.   int free_count = 0;
  627.   unsigned long pixels_to_free[2];
  628.   enum image_instance_type type;
  629.  
  630.   /* #### Hey Ben!  Something is really screwy here.  It is possible
  631.      to get in here with dest_mask == ~0 (anything).  Even in a case
  632.      like this:
  633.  
  634.      [xbm :file "/foo/bar/baz"] 
  635.  
  636.      and in that case this used to pick it up as a cursor because that
  637.      was the first check.  Way bogus.  For now I've moved the cursor
  638.      check to the end.  I think that maybe there should be some
  639.      additional checks being made about setting dest_mask somewhere up
  640.      the call chain, though. */
  641.  
  642.   if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) &&
  643.       (dest_mask & IMAGE_COLOR_PIXMAP_MASK))
  644.     {
  645.       if (!NILP (foreground) || !NILP (background))
  646.     type = IMAGE_COLOR_PIXMAP;
  647.       else
  648.     type = IMAGE_MONO_PIXMAP;
  649.     }
  650.   else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
  651.     type = IMAGE_MONO_PIXMAP;
  652.   else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
  653.     type = IMAGE_COLOR_PIXMAP;
  654.   else if (dest_mask & IMAGE_CURSOR_MASK)
  655.     type = IMAGE_CURSOR;
  656.   else
  657.     {
  658.       if (!no_error)
  659.     signal_simple_error ("No compatible image-instance types given",
  660.                  instantiator);
  661.       return 0;
  662.     }
  663.  
  664.   x_initialize_pixmap_image_instance (ii);
  665.   IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width;
  666.   IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height;
  667.   IMAGE_INSTANCE_TYPE (ii) = type;
  668.   IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
  669.     find_keyword_in_vector (instantiator, Q_file);
  670.   IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
  671.     find_keyword_in_vector (instantiator, Q_hotspot_x);
  672.   IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
  673.     find_keyword_in_vector (instantiator, Q_hotspot_y);
  674.  
  675.   switch (type)
  676.     {
  677.     case IMAGE_MONO_PIXMAP:
  678.       {
  679.     IMAGE_INSTANCE_X_PIXMAP (ii) =
  680.       XCreatePixmapFromBitmapData (DisplayOfScreen (scr),
  681.                        RootWindowOfScreen (scr),
  682.                        (char *) bits, width, height,
  683.                        1, 0, 1);
  684.       }
  685.       break;
  686.  
  687.     case IMAGE_COLOR_PIXMAP:
  688.       {
  689.     Dimension d = DefaultDepthOfScreen (scr);
  690.     unsigned long fg = BlackPixelOfScreen (scr);
  691.     unsigned long bg = WhitePixelOfScreen (scr);
  692.     XColor color;
  693.     Colormap cmap = DefaultColormapOfScreen (scr);
  694.  
  695.     if (!NILP (foreground))
  696.       foreground = Fmake_color_instance (foreground, device,
  697.                          no_error ? Qt : Qnil);
  698.  
  699.     /* Duplicate the pixel values so that we still have a lock on them if
  700.        the pixels we were passed are later freed. */
  701.     if (!NILP (foreground))
  702.       {
  703.         color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
  704.         if (! XAllocColor (dpy, cmap, &color))
  705.           abort ();
  706.         fg = color.pixel;
  707.         pixels_to_free[free_count++] = fg;
  708.       }
  709.  
  710.     if (!NILP (background))
  711.       background = Fmake_color_instance (background, device,
  712.                          no_error ? Qt : Qnil);
  713.  
  714.     /* Duplicate the pixel values so that we still have a lock on them if
  715.        the pixels we were passed are later freed. */
  716.     if (!NILP (background))
  717.       {
  718.         color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
  719.         if (! XAllocColor (dpy, cmap, &color))
  720.           abort ();
  721.         bg = color.pixel;
  722.         pixels_to_free[free_count++] = bg;
  723.       }
  724.  
  725.     IMAGE_INSTANCE_X_PIXMAP (ii) =
  726.       XCreatePixmapFromBitmapData (DisplayOfScreen (scr),
  727.                        RootWindowOfScreen (scr),
  728.                        (char *) bits, width, height,
  729.                        fg, bg, d);
  730.     IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
  731.       }
  732.       break;
  733.  
  734.     case IMAGE_CURSOR:
  735.       {
  736.     XColor fg_color, bg_color;
  737.     Pixmap source =
  738.       XCreatePixmapFromBitmapData (DisplayOfScreen (scr),
  739.                        RootWindowOfScreen (scr),
  740.                        (char *) bits, width, height,
  741.                        1, 0, 1);
  742.  
  743.     if (!NILP (foreground))
  744.       foreground = Fmake_color_instance (foreground, device,
  745.                          no_error ? Qt : Qnil);
  746.     if (!NILP (foreground))
  747.       fg_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
  748.     else
  749.       {
  750.         fg_color.pixel = 0;
  751.         fg_color.red = fg_color.green = fg_color.blue = 0;
  752.       }
  753.  
  754.     if (!NILP (background))
  755.       background = Fmake_color_instance (background, device,
  756.                          no_error ? Qt : Qnil);
  757.     if (!NILP (background))
  758.       bg_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
  759.     else
  760.       {
  761.         bg_color.pixel = 0;
  762.         bg_color.red = bg_color.green = bg_color.blue = ~0;
  763.       }
  764.  
  765.     IMAGE_INSTANCE_X_CURSOR (ii) =
  766.       XCreatePixmapCursor
  767.         (dpy, source, mask, &fg_color, &bg_color,
  768.          !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ?
  769.          XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0,
  770.          !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ?
  771.          XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0);
  772.       }
  773.       break;
  774.  
  775.     default:
  776.       abort ();
  777.     }
  778.  
  779.   if (free_count)
  780.     {
  781.       IMAGE_INSTANCE_X_NPIXELS (ii) = free_count;
  782.       IMAGE_INSTANCE_X_PIXELS (ii) =
  783.     xmalloc (free_count * sizeof (unsigned long));
  784.       memcpy (IMAGE_INSTANCE_X_PIXELS (ii), pixels_to_free,
  785.           free_count * sizeof (unsigned long));
  786.     }
  787.  
  788.   return 1;
  789. }
  790.  
  791. /* Instantiate method for XBM's. */
  792.  
  793. static int
  794. xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
  795.          int dest_mask, int no_error)
  796. {
  797.   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
  798.   Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data);
  799.   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
  800.   Pixmap mask = 0;
  801.  
  802.   assert (!NILP (data));
  803.  
  804.   if (!NILP (mask_data))
  805.     mask =
  806.       pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii),
  807.                   XINT (XCAR (mask_data)),
  808.                   XINT (XCAR (XCDR (mask_data))),
  809.                   (char *) string_data
  810.                   (XSTRING (XCAR (XCDR (XCDR (mask_data))))));
  811.   
  812.   return (init_image_instance_from_xbm_inline
  813.       (ii, XINT (XCAR (data)), XINT (XCAR (XCDR (data))),
  814.        string_data (XSTRING (XCAR (XCDR (XCDR (data))))),
  815.        instantiator, dest_mask, mask,
  816.        find_keyword_in_vector (instantiator, Q_mask_file),
  817.        no_error));
  818. }
  819.  
  820.  
  821. #ifdef HAVE_JPEG
  822.  
  823. /**********************************************************************
  824.  *                             JPEG                                   *
  825.  **********************************************************************/
  826.  
  827. static int
  828. jpeg_validate (Lisp_Object instantiator, int no_error)
  829. {
  830.   return file_or_data_must_be_present (instantiator, no_error);
  831. }
  832.  
  833. static Lisp_Object
  834. jpeg_to_lisp_data (Lisp_Object name, int no_error, int ok_if_data_invalid)
  835. {
  836. }
  837.  
  838. static Lisp_Object jpeg_normalize (Lisp_Object inst, Lisp_Object device_type,
  839.                    int no_error)
  840. {
  841.   return Qnil;
  842. }
  843.  
  844. static int
  845. jpeg_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
  846.           int dest_mask, int no_error)
  847. {
  848.   return 0;
  849. }
  850.  
  851. #endif /* HAVE_JPEG */
  852.  
  853.  
  854. #ifdef HAVE_GIF
  855.  
  856. /**********************************************************************
  857.  *                             GIF                                    *
  858.  **********************************************************************/
  859.  
  860. static int
  861. gif_validate (Lisp_Object instantiator, int no_error)
  862. {
  863.   return file_or_data_must_be_present (instantiator, no_error);
  864. }
  865.  
  866. static Lisp_Object
  867. gif_to_lisp_data (Lisp_Object name, int no_error, int ok_if_data_invalid)
  868. {
  869. }
  870.  
  871. static Lisp_Object
  872. gif_normalize (Lisp_Object inst, Lisp_Object device_type,
  873.            int no_error)
  874. {
  875.   return Qnil;
  876. }
  877.  
  878. static int
  879. gif_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
  880.          int dest_mask, int no_error)
  881. {
  882.   return 0;
  883. }
  884.  
  885. #endif /* HAVE_GIF */
  886.  
  887.  
  888. #ifdef HAVE_PNG
  889.  
  890. /**********************************************************************
  891.  *                             PNG                                    *
  892.  **********************************************************************/
  893. static int
  894. png_validate (Lisp_Object instantiator, int no_error)
  895. {
  896.   return file_or_data_must_be_present (instantiator, no_error);
  897. }
  898.  
  899. static Lisp_Object
  900. png_to_lisp_data (Lisp_Object name, int no_error, int ok_if_data_invalid)
  901. {
  902. }
  903.  
  904. static Lisp_Object
  905. png_normalize (Lisp_Object inst, Lisp_Object device_type,
  906.            int no_error)
  907. {
  908.   return Qnil;
  909. }
  910.  
  911. static int
  912. png_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
  913.          int dest_mask, int no_error)
  914. {
  915.   return 0;
  916. }
  917.  
  918. #endif /* HAVE_PNG */
  919.  
  920.  
  921. #ifdef HAVE_XPM
  922.  
  923. /**********************************************************************
  924.  *                             XPM                                    *
  925.  **********************************************************************/
  926.  
  927. static int
  928. valid_xpm_color_symbols_p (Lisp_Object data, int no_error)
  929. {
  930.   Lisp_Object rest;
  931.   
  932.   for (rest = data; !NILP (rest); rest = XCDR (rest))
  933.     {
  934.       if (!CONSP (rest) ||
  935.       !CONSP (XCAR (rest)) ||
  936.       !STRINGP (XCAR (XCAR (rest))) ||
  937.       (!STRINGP (XCDR (XCAR (rest))) &&
  938.        !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
  939.     {
  940.       if (!no_error)
  941.         signal_simple_error ("Invalid color symbol alist",
  942.                  data);
  943.       return 0;
  944.     }
  945.     }
  946.  
  947.   return 1;
  948. }
  949.  
  950. static int
  951. xpm_validate (Lisp_Object instantiator, int no_error)
  952. {
  953.   return file_or_data_must_be_present (instantiator, no_error);
  954. }
  955.  
  956. static Lisp_Object
  957. pixmap_to_lisp_data (Lisp_Object name, int no_error, int ok_if_data_invalid)
  958. {
  959.   char **data;
  960.   int result;
  961.  
  962.   result = XpmReadFileToData ((char *) string_data (XSTRING (name)), &data);
  963.  
  964.   if (result == XpmSuccess)
  965.     {
  966.       Lisp_Object retval = Qnil;
  967.       Lisp_Object old_inhibit_quit = Vinhibit_quit;
  968.       struct buffer *old_buffer = current_buffer;
  969.       Lisp_Object temp_buffer =
  970.     Fget_buffer_create (build_string (" *pixmap conversion*"));
  971.       int elt;
  972.       int height, width, ncolors;
  973.       struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
  974.  
  975.       GCPRO4 (name, retval, old_inhibit_quit, temp_buffer);
  976.  
  977.       Vinhibit_quit = Qt;
  978.       set_buffer_internal (XBUFFER (temp_buffer));
  979.       Ferase_buffer (Fcurrent_buffer ());
  980.  
  981.       buffer_insert_c_string (current_buffer, "/* XPM */\r");
  982.       buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
  983.  
  984.       sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
  985.       for (elt = 0; elt <= width + ncolors; elt++)
  986.     {
  987.       buffer_insert_c_string (current_buffer, "\"");
  988.       buffer_insert_c_string (current_buffer, data[elt]);
  989.  
  990.       if (elt < width + ncolors)
  991.         buffer_insert_c_string (current_buffer, "\",\r");
  992.       else
  993.         buffer_insert_c_string (current_buffer, "\"};\r");
  994.     }
  995.  
  996.       retval = Fbuffer_substring (Qnil, Qnil, Fcurrent_buffer ());
  997.       XpmFree (data);
  998.  
  999.       set_buffer_internal (old_buffer);
  1000.       Vinhibit_quit = old_inhibit_quit;
  1001.  
  1002.       RETURN_UNGCPRO (retval);
  1003.     }
  1004.  
  1005.   switch (result)
  1006.     {
  1007.     case XpmFileInvalid:
  1008.       {
  1009.     if (ok_if_data_invalid)
  1010.       return Qt;
  1011.     if (!no_error)
  1012.       signal_simple_error ("invalid XPM data in file", name);
  1013.     break;
  1014.       }
  1015.     case XpmNoMemory:
  1016.       {
  1017.     if (!no_error)
  1018.       signal_double_file_error ("Reading pixmap file",
  1019.                     "out of memory", name);
  1020.     break;
  1021.       }
  1022.     case XpmOpenFailed:
  1023.       {
  1024.     /* should never happen? */
  1025.     if (!no_error)
  1026.       signal_double_file_error ("Opening pixmap file",
  1027.                     "no such file or directory", name);
  1028.     break;
  1029.       }
  1030.     default:
  1031.       {
  1032.     if (!no_error)
  1033.       signal_double_file_error_2 ("Parsing pixmap file",
  1034.                       "unknown error code",
  1035.                       make_number (result), name);
  1036.     break;
  1037.       }
  1038.     }
  1039.  
  1040.   return Qnil;
  1041. }
  1042.  
  1043. Lisp_Object Vxpm_color_symbols;
  1044.  
  1045. static Lisp_Object
  1046. evaluate_xpm_color_symbols (int no_error)
  1047. {
  1048.   Lisp_Object rest, results = Qnil;
  1049.   struct gcpro gcpro1, gcpro2;
  1050.  
  1051.   GCPRO2 (rest, results);
  1052.   for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
  1053.     {
  1054.       Lisp_Object name, value, cons;
  1055.  
  1056.       if (!CONSP (rest))
  1057.     {
  1058.       if (!no_error)
  1059.         CHECK_CONS (rest, 0);
  1060.       UNGCPRO;
  1061.       return Qnil;
  1062.     }
  1063.       cons = XCAR (rest);
  1064.       if (!CONSP (cons))
  1065.     {
  1066.       if (!no_error)
  1067.         CHECK_CONS (cons, 0);
  1068.       UNGCPRO;
  1069.       return Qnil;
  1070.     }
  1071.       name = XCAR (cons);
  1072.       if (!STRINGP (name))
  1073.     {
  1074.       if (!no_error)
  1075.         CHECK_STRING (name, 0);
  1076.       UNGCPRO;
  1077.       return Qnil;
  1078.     }
  1079.       value = XCDR (cons);
  1080.       if (!CONSP (value))
  1081.     {
  1082.       if (!no_error)
  1083.         CHECK_CONS (value, 0);
  1084.       UNGCPRO;
  1085.       return Qnil;
  1086.     }
  1087.       value = XCAR (value);
  1088.       value = Feval (value);
  1089.       if (NILP (value))
  1090.     continue;
  1091.       if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
  1092.     {
  1093.       if (!no_error)
  1094.         signal_simple_error
  1095.           ("Result from xpm-color-symbols eval must be nil, string, or color",
  1096.            value);
  1097.       UNGCPRO;
  1098.       return Qnil;
  1099.     }
  1100.       results = Fcons (Fcons (name, value), results);
  1101.     }
  1102.   UNGCPRO;            /* no more evaluation */
  1103.   return results;
  1104. }
  1105.  
  1106. static Lisp_Object
  1107. xpm_normalize (Lisp_Object inst, Lisp_Object device_type,
  1108.            int no_error)
  1109. {
  1110.   Lisp_Object file = Qnil;
  1111.   Lisp_Object color_symbols;
  1112.   struct gcpro gcpro1, gcpro2;
  1113.   Lisp_Object alist = Qnil;
  1114.   
  1115.   GCPRO2 (file, alist);
  1116.  
  1117.   /* Now, convert any file data into inline data.  At the end of this,
  1118.      `data' will contain the inline data (if any) or Qnil, and
  1119.      `file' will contain the name this data was derived from (if
  1120.      known) or Qnil.
  1121.  
  1122.      Note that if we cannot generate any regular inline data, we
  1123.      skip out. */
  1124.  
  1125.   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data);
  1126.  
  1127.   if (EQ (file, Qt)) /* failure locating filename */
  1128.     {
  1129.       if (!no_error)
  1130.     signal_double_file_error ("Opening pixmap file",
  1131.                   "no such file or directory",
  1132.                   file);
  1133.       RETURN_UNGCPRO (Qnil);
  1134.     }
  1135.  
  1136.   color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
  1137.                            Qunbound);
  1138.  
  1139.   if (NILP (file) && !UNBOUNDP (color_symbols))
  1140.     /* no conversion necessary */
  1141.     RETURN_UNGCPRO (inst);
  1142.  
  1143.   alist = tagged_vector_to_alist (inst);
  1144.  
  1145.   if (!NILP (file))
  1146.     {
  1147.       Lisp_Object data = pixmap_to_lisp_data (file, no_error, 0);
  1148.       if (NILP (data)) /* conversion failure; error should
  1149.                   already be signalled. */
  1150.     RETURN_UNGCPRO (Qnil);
  1151.       alist = remassq_no_quit (Q_file, alist);
  1152.       /* there can't be a :data at this point. */
  1153.       alist = Fcons (Fcons (Q_file, file),
  1154.              Fcons (Fcons (Q_data, data), alist));
  1155.     }
  1156.  
  1157.   if (UNBOUNDP (color_symbols))
  1158.     {
  1159.       color_symbols = evaluate_xpm_color_symbols (no_error);
  1160.       alist = Fcons (Fcons (Q_color_symbols, color_symbols),
  1161.              alist);
  1162.     }
  1163.  
  1164.   {
  1165.     Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
  1166.     free_alist (alist);
  1167.     RETURN_UNGCPRO (result);
  1168.   }
  1169. }
  1170.  
  1171.  /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()...
  1172.     There was no version number in xpm.h before 3.3, but this should do.
  1173.   */
  1174. #if (XpmVersion >= 3) || defined(XpmExactColors)
  1175. # define XPM_DOES_BUFFERS
  1176. #endif
  1177.  
  1178. #ifndef XPM_DOES_BUFFERS
  1179. Your version of XPM is too old.  You cannot compile with it.
  1180. Upgrade to version 3.2g or better or compile with --with-xpm=no.
  1181. #endif /* !XPM_DOES_BUFFERS */
  1182.  
  1183. static XpmColorSymbol *
  1184. extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device,
  1185.              Lisp_Object color_symbol_alist, int no_error)
  1186. {
  1187.   /* This function can GC */
  1188.   Screen *xs = LISP_DEVICE_TO_X_SCREEN (device);
  1189.   Display *dpy = DisplayOfScreen (xs);
  1190.   Colormap cmap = DefaultColormapOfScreen (xs);
  1191.   XColor color;
  1192.   Lisp_Object rest;
  1193.   Lisp_Object results = Qnil;
  1194.   int i;
  1195.   XpmColorSymbol *symbols;
  1196.   struct gcpro gcpro1, gcpro2;
  1197.  
  1198.   GCPRO2 (results, device);
  1199.  
  1200.   /* We built up results to be (("name" . #<color>) ...) so that if an
  1201.      error happens we don't lose any malloc()ed data, or more importantly,
  1202.      leave any pixels allocated in the server. */
  1203.   i = 0;
  1204.   LIST_LOOP (rest, color_symbol_alist)
  1205.     {
  1206.       Lisp_Object cons = XCAR (rest);
  1207.       Lisp_Object name = XCAR (cons);
  1208.       Lisp_Object value = XCDR (cons);
  1209.       if (NILP (value))
  1210.     continue;
  1211.       if (STRINGP (value))
  1212.     value = Fmake_color_instance (value, device, no_error ? Qt : Qnil);
  1213.       else
  1214.         {
  1215.           assert (COLOR_SPECIFIERP (value));
  1216.           value = Fspecifier_instance (value, device, Qnil, Qnil);
  1217.         }
  1218.       if (NILP (value))
  1219.         continue;
  1220.       results = Fcons (Fcons (name, value), results);
  1221.       i++;
  1222.     }
  1223.   UNGCPRO;            /* no more evaluation */
  1224.  
  1225.   if (i == 0) return 0;
  1226.  
  1227.   symbols = (XpmColorSymbol *) xmalloc (i * sizeof (XpmColorSymbol));
  1228.   xpmattrs->valuemask |= XpmColorSymbols;
  1229.   xpmattrs->colorsymbols = symbols;
  1230.   xpmattrs->numsymbols = i;
  1231.  
  1232.   while (--i >= 0)
  1233.     {
  1234.       Lisp_Object cons = XCAR (results);
  1235.       color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons)));
  1236.       /* Duplicate the pixel value so that we still have a lock on it if
  1237.      the pixel we were passed is later freed. */
  1238.       if (! XAllocColor (dpy, cmap, &color))
  1239.     abort ();  /* it must be allocable since we're just duplicating it */
  1240.  
  1241.       symbols [i].name = (char *) string_data (XSTRING (XCAR (cons)));
  1242.       symbols [i].pixel = color.pixel;
  1243.       symbols [i].value = 0;
  1244.       results = XCDR (results);
  1245.       free_cons (XCONS (cons));
  1246.     }
  1247.   return symbols;
  1248. }
  1249.  
  1250. static void
  1251. xpm_free (XpmAttributes *xpmattrs)
  1252. {
  1253.   /* Could conceivably lose if XpmXXX returned an error without first
  1254.      initializing this structure, if we didn't know that initializing it
  1255.      to all zeros was ok (and also that it's ok to call XpmFreeAttributes()
  1256.      multiple times, since it zeros slots as it frees them...) */
  1257.   XpmFreeAttributes (xpmattrs);
  1258. }
  1259.  
  1260. static int
  1261. xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
  1262.          int dest_mask, int no_error)
  1263. {
  1264.   /* This function can GC */
  1265.   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
  1266.   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
  1267.   int force_mono;
  1268.   Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
  1269.   Screen *xs = LISP_DEVICE_TO_X_SCREEN (device);
  1270.   Pixmap pixmap;
  1271.   Pixmap mask = 0;
  1272.   XpmAttributes xpmattrs;
  1273.   int result;
  1274.   XpmColorSymbol *color_symbols;
  1275.   Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator,
  1276.                                Q_color_symbols);
  1277.  
  1278.   if (dest_mask & IMAGE_COLOR_PIXMAP_MASK)
  1279.     force_mono = 0;
  1280.   else if (dest_mask & IMAGE_MONO_PIXMAP_MASK)
  1281.     force_mono = 1;
  1282.   else
  1283.     {
  1284.       if (!no_error)
  1285.     signal_simple_error ("No compatible image-instance types given",
  1286.                  instantiator);
  1287.       return 0;
  1288.     }
  1289.  
  1290.   x_initialize_pixmap_image_instance (ii);
  1291.   if (force_mono)
  1292.     IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
  1293.   else
  1294.     IMAGE_INSTANCE_TYPE (ii) = IMAGE_COLOR_PIXMAP;
  1295.  
  1296.   assert (!NILP (data));
  1297.  
  1298.  retry:
  1299.  
  1300.   memset (&xpmattrs, 0, sizeof (xpmattrs)); /* want XpmInitAttributes() */
  1301.   xpmattrs.valuemask = XpmReturnPixels;
  1302.   if (force_mono)
  1303.     {
  1304.       /* Without this, we get a 1-bit version of the color image, which
  1305.      isn't quite right.  With this, we get the mono image, which might
  1306.      be very different looking. */
  1307.       xpmattrs.valuemask |= XpmColorKey;
  1308.       xpmattrs.color_key = XPM_MONO;
  1309.       xpmattrs.depth = 1;
  1310.       xpmattrs.valuemask |= XpmDepth;
  1311.     }
  1312.   else
  1313.     {
  1314.       xpmattrs.closeness = 65535;
  1315.       xpmattrs.valuemask |= XpmCloseness;
  1316.     }
  1317.   
  1318.   color_symbols = extract_xpm_color_names (&xpmattrs, device,
  1319.                        color_symbol_alist,
  1320.                        no_error);
  1321.  
  1322.   result = XpmCreatePixmapFromBuffer (DisplayOfScreen (xs),
  1323.                       RootWindowOfScreen (xs),
  1324.                       (char *)
  1325.                       string_data (XSTRING (data)),
  1326.                       &pixmap, &mask, &xpmattrs);
  1327.  
  1328.   if (color_symbols)
  1329.     {
  1330.       xfree (color_symbols);
  1331.       xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */
  1332.       xpmattrs.numsymbols = 0;
  1333.     }
  1334.  
  1335.   switch (result)
  1336.     {
  1337.     case XpmSuccess:
  1338.       break;
  1339.     case XpmFileInvalid:
  1340.       {
  1341.     xpm_free (&xpmattrs);
  1342.     if (!no_error)
  1343.       signal_simple_error ("invalid XPM data", data);
  1344.     return 0;
  1345.       }
  1346.     case XpmColorFailed:
  1347.     case XpmColorError:
  1348.       {
  1349.     xpm_free (&xpmattrs);
  1350.     if (force_mono)
  1351.       {
  1352.         if (!no_error)
  1353.           /* second time; blow out. */
  1354.           signal_double_file_error ("Reading pixmap data",
  1355.                     "color allocation failed",
  1356.                     data);
  1357.         return 0;
  1358.       }
  1359.     else
  1360.       {
  1361.         if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK))
  1362.           {
  1363.         if (!no_error)
  1364.           /* second time; blow out. */
  1365.           signal_double_file_error ("Reading pixmap data",
  1366.                         "color allocation failed",
  1367.                         data);
  1368.         return 0;
  1369.           }
  1370.         force_mono = 1;
  1371.         IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP;
  1372.         goto retry;
  1373.       }
  1374.       }
  1375.     case XpmNoMemory:
  1376.       {
  1377.     xpm_free (&xpmattrs);
  1378.     if (!no_error)
  1379.       signal_double_file_error ("Parsing pixmap data",
  1380.                     "out of memory", data);
  1381.     return 0;
  1382.       }
  1383.     default:
  1384.       {
  1385.     xpm_free (&xpmattrs);
  1386.     if (!no_error)
  1387.       signal_double_file_error_2 ("Parsing pixmap data",
  1388.                       "unknown error code",
  1389.                       make_number (result), data);
  1390.     else
  1391.       return 0;
  1392.       }
  1393.     }
  1394.   {
  1395.     /* XpmReadFileToPixmap() doesn't return the depth (bogus!) so we need to
  1396.        get it ourself.  (No, xpmattrs.depth is not it; that's an input slot,
  1397.        not output.)  We could just assume that it has the same depth as the
  1398.        root window, but some devices allow more than one depth, so that isn't
  1399.        necessarily correct (I guess?) */
  1400.     Window root;
  1401.     int x, y;
  1402.     unsigned int w2, h2, bw;
  1403.  
  1404.     unsigned int w = xpmattrs.width;
  1405.     unsigned int h = xpmattrs.height;
  1406.     unsigned int d;
  1407.     int xhot = ((xpmattrs.valuemask & XpmHotspot) ? xpmattrs.x_hotspot : -1);
  1408.     int yhot = ((xpmattrs.valuemask & XpmHotspot) ? xpmattrs.y_hotspot : -1);
  1409.     int npixels = xpmattrs.npixels;
  1410.     Pixel *pixels = 0;
  1411.  
  1412.     if (npixels != 0)
  1413.       {
  1414.     pixels = xmalloc (npixels * sizeof (Pixel));
  1415.     memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel));
  1416.       }
  1417.     else
  1418.       pixels = 0;
  1419.  
  1420.     xpm_free (&xpmattrs);    /* after we've read pixels and hotspot */
  1421.  
  1422.     if (!XGetGeometry (DisplayOfScreen (xs), pixmap, &root, &x, &y,
  1423.                        &w2, &h2, &bw, &d))
  1424.       abort ();
  1425.     if (w != w2 || h != h2)
  1426.       abort ();
  1427.  
  1428.     {
  1429.       IMAGE_INSTANCE_PIXMAP_FILENAME (ii) =
  1430.     find_keyword_in_vector (instantiator, Q_file);
  1431.       if (xhot >= 0)
  1432.     IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = make_number (xhot);
  1433.       if (yhot >= 0)
  1434.     IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = make_number (yhot);
  1435.       IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap;
  1436.       IMAGE_INSTANCE_X_MASK (ii) = mask;
  1437.       IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w;
  1438.       IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h;
  1439.       IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d;
  1440.       IMAGE_INSTANCE_X_PIXELS (ii) = pixels;
  1441.       IMAGE_INSTANCE_X_NPIXELS (ii) = npixels;
  1442.     }
  1443.   }
  1444.  
  1445.   return 1;
  1446. }
  1447.  
  1448. #endif /* HAVE_XPM */
  1449.  
  1450.  
  1451. #ifdef HAVE_XFACE
  1452.  
  1453. /**********************************************************************
  1454.  *                             X-Face                                 *
  1455.  **********************************************************************/
  1456.  
  1457. static int
  1458. xface_validate (Lisp_Object instantiator, int no_error)
  1459. {
  1460.   return file_or_data_must_be_present (instantiator, no_error);
  1461. }
  1462.  
  1463. static Lisp_Object
  1464. xface_normalize (Lisp_Object inst, Lisp_Object device_type,
  1465.          int no_error)
  1466. {
  1467.   Lisp_Object file = Qnil;
  1468.   struct gcpro gcpro1, gcpro2;
  1469.   Lisp_Object alist = Qnil;
  1470.   
  1471.   GCPRO2 (file, alist);
  1472.  
  1473.   /* Now, convert any file data into inline data for both the regular
  1474.      data and the mask data.  At the end of this, `data' will contain
  1475.      the inline data (if any) or Qnil, and `file' will contain
  1476.      the name this data was derived from (if known) or Qnil.
  1477.      Likewise for `mask_file' and `mask_data'.
  1478.  
  1479.      Note that if we cannot generate any regular inline data, we
  1480.      skip out. */
  1481.  
  1482.   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data);
  1483.  
  1484.   if (EQ (file, Qt)) /* failure locating filename */
  1485.     {
  1486.       if (!no_error)
  1487.     signal_double_file_error ("Opening bitmap file",
  1488.                   "no such file or directory",
  1489.                   file);
  1490.       RETURN_UNGCPRO (Qnil);
  1491.     }
  1492.  
  1493.   if (NILP (file)) /* no conversion necessary */
  1494.     RETURN_UNGCPRO (inst);
  1495.  
  1496.   alist = tagged_vector_to_alist (inst);
  1497.  
  1498.   {
  1499.     Lisp_Object data = make_string_from_file (file);
  1500.     alist = remassq_no_quit (Q_file, alist);
  1501.     /* there can't be a :data at this point. */
  1502.     alist = Fcons (Fcons (Q_file, file),
  1503.            Fcons (Fcons (Q_data, data), alist));
  1504.   }
  1505.  
  1506.   {
  1507.     Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
  1508.     free_alist (alist);
  1509.     RETURN_UNGCPRO (result);
  1510.   }
  1511. }
  1512.  
  1513. /* We have to define SYSV32 so that compface.h includes string.h
  1514.    instead of strings.h. */
  1515. #define SYSV32
  1516. #include <compface.h>
  1517. jmp_buf comp_env;
  1518. #undef SYSV32
  1519.  
  1520. static int
  1521. xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
  1522.            int dest_mask, int no_error)
  1523. {
  1524.   Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
  1525.   struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
  1526.   int i, status;
  1527.   char *p, *bits, *bp, *emsg = NULL, *dstring;
  1528.  
  1529.   assert (!NILP (data));
  1530.  
  1531.   dstring = (char *) string_data (XSTRING (data));
  1532.  
  1533.   if ((p = strchr (dstring, ':')))
  1534.     {
  1535.       dstring = p + 1;
  1536.     }
  1537.  
  1538.   if (!(status = setjmp (comp_env)))
  1539.     {
  1540.       UnCompAll (dstring);
  1541.       UnGenFace ();
  1542.     }
  1543.  
  1544.   switch (status)
  1545.     {
  1546.     case -2:
  1547.       emsg = "uncompface: internal error";
  1548.       break;
  1549.     case -1:
  1550.       emsg = "uncompface: insufficient or invalid data";
  1551.       break;
  1552.     case 1:
  1553.       emsg = "uncompface: excess data ignored";
  1554.       break;
  1555.     }
  1556.  
  1557.   if (emsg)
  1558.     {
  1559.       if (!no_error)
  1560.     signal_simple_error (emsg, data);
  1561.       return 0;
  1562.     }
  1563.  
  1564.   bp = bits = (char *) alloca (PIXELS / 8);
  1565.  
  1566.   /* the compface library exports char F[], which uses a single byte per
  1567.      pixel to represent a 48x48 bitmap.  Yuck. */
  1568.   for (i = 0, p = F; i < (PIXELS / 8); ++i)
  1569.     {
  1570.       int n, b;
  1571.       /* reverse the bit order of each byte... */
  1572.       for (b = n = 0; b < 8; ++b)
  1573.     {
  1574.       n |= ((*p++) << b);
  1575.     }
  1576.       *bp++ = (char) n;
  1577.     }
  1578.  
  1579.   return init_image_instance_from_xbm_inline (ii, 48, 48,
  1580.                           (unsigned char *) bits,
  1581.                           instantiator, dest_mask,
  1582.                           0, Qnil, no_error);
  1583. }
  1584.  
  1585. #endif /* HAVE_XFACE */
  1586.  
  1587.  
  1588. /**********************************************************************
  1589.  *                           Autodetect                               *
  1590.  **********************************************************************/
  1591.  
  1592. static int
  1593. autodetect_validate (Lisp_Object instantiator, int no_error)
  1594. {
  1595.   return data_must_be_present (instantiator, no_error);
  1596. }
  1597.  
  1598. static Lisp_Object
  1599. autodetect_normalize (Lisp_Object instantiator, Lisp_Object device_type,
  1600.               int no_error)
  1601. {
  1602.   Lisp_Object file = find_keyword_in_vector (instantiator, Q_data);
  1603.   Lisp_Object filename = Qnil;
  1604.   Lisp_Object data = Qnil;
  1605.   struct gcpro gcpro1, gcpro2, gcpro3;
  1606.   Lisp_Object alist = Qnil;
  1607.  
  1608.   GCPRO3 (filename, data, alist);
  1609.  
  1610.   if (NILP (file)) /* no conversion necessary */
  1611.     RETURN_UNGCPRO (instantiator);
  1612.  
  1613.   alist = tagged_vector_to_alist (instantiator);
  1614.  
  1615.   filename = locate_pixmap_file (file);
  1616.   if (!NILP (filename))
  1617.     {
  1618.       int xhot, yhot;
  1619.       /* #### Apparently some versions of XpmReadFileToData which is
  1620.      called by pixmap_to_lisp_data don't return an error value
  1621.      if the given file is not a valid XPM file.  Instead, they
  1622.      just seg fault.  It is definitely caused by passing a
  1623.      bitmap.  To try and avoid this we check for bitmaps first.  */
  1624.       
  1625.       data = bitmap_to_lisp_data (filename, &xhot, &yhot, no_error, 1);
  1626.       if (NILP (data))
  1627.     /* error in conversion, other than invalid data */
  1628.     RETURN_UNGCPRO (Qnil);
  1629.  
  1630.       if (!EQ (data, Qt))
  1631.     {
  1632.       alist = remassq_no_quit (Q_data, alist);
  1633.       alist = Fcons (Fcons (Q_file, filename),
  1634.              Fcons (Fcons (Q_data, data), alist));
  1635.       if (xhot != -1)
  1636.         alist = Fcons (Fcons (Q_hotspot_x, make_number (xhot)),
  1637.                alist);
  1638.       if (yhot != -1)
  1639.         alist = Fcons (Fcons (Q_hotspot_y, make_number (yhot)),
  1640.                alist);
  1641.       
  1642.       {
  1643.         Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
  1644.         free_alist (alist);
  1645.         RETURN_UNGCPRO (result);
  1646.       }
  1647.     }
  1648.  
  1649. #ifdef HAVE_XPM
  1650.       data = pixmap_to_lisp_data (filename, no_error, 1);
  1651.       if (NILP (data)) /* conversion failure; error should
  1652.                   already be signalled. */
  1653.     RETURN_UNGCPRO (Qnil);
  1654.  
  1655.       if (!EQ (data, Qt))
  1656.     {
  1657.       alist = remassq_no_quit (Q_data, alist);
  1658.       alist = Fcons (Fcons (Q_file, filename),
  1659.              Fcons (Fcons (Q_data, data), alist));
  1660.       alist = Fcons (Fcons (Q_color_symbols,
  1661.                 evaluate_xpm_color_symbols (no_error)),
  1662.              alist);
  1663.       {
  1664.         Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
  1665.         free_alist (alist);
  1666.         RETURN_UNGCPRO (result);
  1667.       }
  1668.     }
  1669. #endif
  1670.     }
  1671.  
  1672.   alist = remassq_no_quit (Q_data, alist);
  1673.   alist = Fcons (Fcons (Q_data, file), alist);
  1674.  
  1675.   {
  1676.     Lisp_Object result = alist_to_tagged_vector (Qstring, alist);
  1677.     free_alist (alist);
  1678.     RETURN_UNGCPRO (result);
  1679.   }
  1680. }
  1681.  
  1682. static int
  1683. autodetect_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
  1684.             int dest_mask, int no_error)
  1685. {
  1686.   abort (); /* Should never get here.  Anything that was `autodetect'
  1687.            should have been converted to something else by the
  1688.            normalization code. */
  1689.   return 0;
  1690. }
  1691.  
  1692.  
  1693. /**********************************************************************
  1694.  *                           Misc image                               *
  1695.  **********************************************************************/
  1696.  
  1697. /* #### This function could fuck with pixmap caches.  Need to rethink. */
  1698.  
  1699. DEFUN ("colorize-image-instance", Fcolorize_image_instance,
  1700.        Scolorize_image_instance, 3, 3, 0,
  1701.        "Make the image instance be displayed in the given colors.\n\
  1702. Image instances come in two varieties: bitmaps, which are 1 bit deep which\n\
  1703. are rendered in the prevailing foreground and background colors; and\n\
  1704. pixmaps, which are of arbitrary depth (including 1) and which have the\n\
  1705. colors explicitly specified.  This function converts a bitmap to a pixmap.\n\
  1706. If the image instance was a pixmap already, nothing is done (and nil is\n\
  1707. returned).  Otherwise t is returned.")
  1708.   (image_instance, foreground, background)
  1709.   Lisp_Object image_instance, foreground, background;
  1710. {
  1711.   struct Lisp_Image_Instance *p;
  1712.  
  1713.   CHECK_IMAGE_INSTANCE (image_instance, 0);
  1714.   CHECK_COLOR_INSTANCE (foreground, 0);
  1715.   CHECK_COLOR_INSTANCE (background, 0);
  1716.   p = XIMAGE_INSTANCE (image_instance);
  1717.   if (IMAGE_INSTANCE_PIXMAP_DEPTH (p) > 0)
  1718.     return Qnil;
  1719.   {
  1720.     Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p)));
  1721.     Screen *scr = DefaultScreenOfDisplay (dpy);
  1722.     Dimension d = DefaultDepthOfScreen (scr);
  1723.     Colormap cmap = DefaultColormapOfScreen (scr);
  1724.     Pixmap new = XCreatePixmap (dpy, RootWindowOfScreen (scr),
  1725.                 IMAGE_INSTANCE_PIXMAP_WIDTH (p),
  1726.                 IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d);
  1727.     XColor color;
  1728.     XGCValues gcv;
  1729.     GC gc;
  1730.     /* Duplicate the pixel values so that we still have a lock on them if
  1731.        the pixels we were passed are later freed. */
  1732.     color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground));
  1733.     if (! XAllocColor (dpy, cmap, &color)) abort ();
  1734.     gcv.foreground = color.pixel;
  1735.     color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background));
  1736.     if (! XAllocColor (dpy, cmap, &color)) abort ();
  1737.     gcv.background = color.pixel;
  1738.     gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv);
  1739.     XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0,
  1740.         IMAGE_INSTANCE_PIXMAP_WIDTH (p), IMAGE_INSTANCE_PIXMAP_HEIGHT (p),
  1741.         0, 0, 1);
  1742.     XFreeGC (dpy, gc);
  1743.     XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP (p));
  1744.     IMAGE_INSTANCE_X_PIXMAP (p) = new;
  1745.     IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d;
  1746.   }
  1747.   return Qt;
  1748. }
  1749.  
  1750.  
  1751. /************************************************************************/
  1752. /*                                cursors                               */
  1753. /************************************************************************/
  1754.  
  1755. /* #### this shit needs overhauling and specifierifying */
  1756.  
  1757. Lisp_Object Qcursorp;
  1758. static Lisp_Object mark_cursor (Lisp_Object, void (*) (Lisp_Object));
  1759. static void print_cursor (Lisp_Object, Lisp_Object, int);
  1760. static void finalize_cursor (void *, int);
  1761. static int cursor_equal (Lisp_Object, Lisp_Object, int depth);
  1762. static unsigned long cursor_hash (Lisp_Object obj, int depth);
  1763. DEFINE_LRECORD_IMPLEMENTATION ("cursor", cursor,
  1764.                    mark_cursor, print_cursor, finalize_cursor,
  1765.                    cursor_equal, cursor_hash, struct Lisp_Cursor);
  1766.  
  1767. static Lisp_Object
  1768. mark_cursor (Lisp_Object obj, void (*markobj) (Lisp_Object))
  1769. {
  1770.   struct Lisp_Cursor *c = XCURSOR (obj);
  1771.   ((markobj) (c->fg));
  1772.   ((markobj) (c->bg));
  1773.   ((markobj) (c->name));
  1774.   return c->device;
  1775. }
  1776.  
  1777. static void
  1778. print_cursor (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
  1779. {
  1780.   char buf[200];
  1781.   struct Lisp_Cursor *c = XCURSOR (obj);
  1782.   if (print_readably)
  1783.     error ("printing unreadable object #<cursor 0x%x>",
  1784.        c->header.uid);
  1785.  
  1786.   write_c_string ("#<cursor ", printcharfun);
  1787.   print_internal (c->name, printcharfun, 1);
  1788.   if (!NILP (c->fg))
  1789.     {
  1790.       write_c_string (" (", printcharfun);
  1791.       print_internal (XCOLOR_INSTANCE (c->fg)->name, printcharfun, 0);
  1792.       write_c_string ("/", printcharfun);
  1793.       print_internal (XCOLOR_INSTANCE (c->bg)->name, printcharfun, 0);
  1794.       write_c_string (")", printcharfun);
  1795.     }
  1796.   sprintf (buf, " 0x%x>", c->header.uid);
  1797.   /* #### should print the device */
  1798.   write_c_string (buf, printcharfun);
  1799. }
  1800.  
  1801. static void
  1802. finalize_cursor (void *header, int for_disksave)
  1803. {
  1804.   struct Lisp_Cursor *c = (struct Lisp_Cursor *) header;
  1805.   if (for_disksave) finalose (c);
  1806.   if (c->cursor)
  1807.     {
  1808.       XFreeCursor (DEVICE_X_DISPLAY (XDEVICE (c->device)), c->cursor);
  1809.       c->cursor = 0;
  1810.     }
  1811. }
  1812.  
  1813. /* Cursors are equal if their names are equal. */
  1814. static int
  1815. cursor_equal (Lisp_Object o1, Lisp_Object o2, int depth)
  1816. {
  1817.   return (internal_equal (XCURSOR (o1)->name, XCURSOR (o2)->name, depth + 1));
  1818. }
  1819.  
  1820. static unsigned long
  1821. cursor_hash (Lisp_Object obj, int depth)
  1822. {
  1823.   return internal_hash (XCURSOR (obj)->name, depth + 1);
  1824. }
  1825.  
  1826. /* XmuCvtStringToCursor is bogus in the following ways:
  1827.  
  1828.    - When it can't convert the given string to a real cursor, it will
  1829.      sometimes return a "success" value, after triggering a BadPixmap
  1830.      error.  It then gives you a cursor that will itself generate BadCursor
  1831.      errors.  So we install this error handler to catch/notice the X error
  1832.      and take that as meaning "couldn't convert."
  1833.  
  1834.    - When you tell it to find a cursor file that doesn't exist, it prints
  1835.      an error message on stderr.  You can't make it not do that.
  1836.  
  1837.    - Also, using Xmu means we can't properly hack Lisp_Image_Instance
  1838.      objects, or XPM files, or $XBMLANGPATH.
  1839.  */
  1840.  
  1841. /* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */
  1842.  
  1843. static int XLoadFont_got_error;
  1844. static int XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror)
  1845. {
  1846.   XLoadFont_got_error = 1;
  1847.   return 0;
  1848. }
  1849.  
  1850. static Font
  1851. safe_XLoadFont (Display *dpy, char *name)
  1852. {
  1853.   Font font;
  1854.   int (*old_handler) ();
  1855.   XLoadFont_got_error = 0;
  1856.   XSync (dpy, 0);
  1857.   old_handler = XSetErrorHandler (XLoadFont_error_handler);
  1858.   font = XLoadFont (dpy, name);
  1859.   XSync (dpy, 0);
  1860.   XSetErrorHandler (old_handler);
  1861.   if (XLoadFont_got_error) return 0;
  1862.   return font;
  1863. }
  1864.  
  1865.  
  1866. static Cursor 
  1867. make_cursor_1 (Lisp_Object device, Lisp_Object name)
  1868. {
  1869.   /* This function can GC */
  1870.   Screen *xs = LISP_DEVICE_TO_X_SCREEN (device);
  1871.   Display *dpy = DisplayOfScreen (xs);
  1872.   XColor fg, bg;
  1873.   Cursor cursor;
  1874.   int i;
  1875.  
  1876.   fg.pixel = bg.pixel = 0;
  1877.   fg.red = fg.green = fg.blue = 0;
  1878.   bg.red = bg.green = bg.blue = ~0;
  1879.  
  1880.   if (STRINGP (name) &&
  1881.       !strncmp ("FONT ", (char *) string_data (XSTRING (name)), 5))
  1882.     {
  1883.       Font source, mask;
  1884.       char source_name [MAXPATHLEN], mask_name [MAXPATHLEN], dummy;
  1885.       int source_char, mask_char;
  1886.       int count = sscanf ((char *) string_data (XSTRING (name)),
  1887.               "FONT %s %d %s %d %c",
  1888.               source_name, &source_char,
  1889.               mask_name, &mask_char, &dummy);
  1890.       /* Allow "%s %d %d" as well... */
  1891.       if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy)))
  1892.     count = 4, mask_name[0] = 0;
  1893.  
  1894.       if (count != 2 && count != 4)
  1895.     signal_simple_error ("invalid cursor specification", name);
  1896.       source = safe_XLoadFont (dpy, source_name);
  1897.       if (! source)
  1898.     signal_simple_error_2 ("couldn't load font",
  1899.                    build_string (source_name),
  1900.                    name);
  1901.       if (count == 2)
  1902.     mask = 0;
  1903.       else if (! mask_name[0])
  1904.     mask = source;
  1905.       else
  1906.     {
  1907.       mask = safe_XLoadFont (dpy, mask_name);
  1908.       if (! mask) /* continuable */
  1909.         Fsignal (Qerror, list3 (build_string ("couldn't load font"),
  1910.                     build_string (mask_name), name));
  1911.     }
  1912.       if (! mask) mask_char = 0;
  1913.  
  1914.       /* #### call XQueryTextExtents() and check_pointer_sizes() here. */
  1915.  
  1916.       cursor = XCreateGlyphCursor (dpy, source, mask, source_char, mask_char,
  1917.                    &fg, &bg);
  1918.       XUnloadFont (dpy, source);
  1919.       if (mask && mask != source) XUnloadFont (dpy, mask);
  1920.     }
  1921.  
  1922.   else if (STRINGP (name) &&
  1923.        (i = XmuCursorNameToIndex (string_ext_data (XSTRING (name)))) != -1)
  1924.     {
  1925.       cursor = XCreateFontCursor (dpy, i);
  1926.     }
  1927.  
  1928.   else
  1929.     {
  1930.       struct gcpro gcpro1, gcpro2, gcpro3;
  1931.       Lisp_Object lsource = Qnil;
  1932.       Lisp_Object lmask = Qnil;
  1933.       Lisp_Object mask_file = Qnil;
  1934.       Pixmap source, mask;
  1935.  
  1936.       GCPRO3 (lsource, lmask, mask_file);
  1937.  
  1938.       if (IMAGE_INSTANCEP (name))
  1939.     lsource = name;
  1940.       else if (GLYPHP (name))
  1941.     lsource = glyph_image_instance (name, device, 0);
  1942.       else
  1943.     /* #### We may not want this to error later on. */
  1944.     lsource = Fmake_image_instance (name, device, Qmono_pixmap, Qnil);
  1945.  
  1946.       if (!IMAGE_INSTANCEP (lsource))
  1947.     signal_simple_error ("Could not obtain image instance", name);
  1948.  
  1949.       if (XIMAGE_INSTANCE_TYPE (lsource) != IMAGE_MONO_PIXMAP)
  1950.     signal_simple_error ("Invalid image-instance type", lsource);
  1951.       source = XIMAGE_INSTANCE_X_PIXMAP (lsource);
  1952.       mask = XIMAGE_INSTANCE_X_MASK (lsource);
  1953.  
  1954.       if (XIMAGE_INSTANCE_PIXMAP_DEPTH (lsource) > 1)
  1955.     signal_error (Qerror,
  1956.               list3 (build_string ("cursor image instances must be 1 plane"),
  1957.                  name, lsource));
  1958.       if (!mask && STRINGP (name))
  1959.     {
  1960.       mask_file =
  1961.         locate_pixmap_file (concat2 (name, build_string ("Mask")));
  1962.       if (NILP (mask_file))
  1963.         mask_file =
  1964.           locate_pixmap_file (concat2 (name, build_string ("msk")));
  1965.       if (!NILP (mask_file))
  1966.         {
  1967.           /* #### We may not want this to error later on. */
  1968.           lmask = Fmake_image_instance (mask_file, device, Qmono_pixmap,
  1969.                         Qnil);
  1970.           if (!IMAGE_INSTANCEP (lmask))
  1971.         signal_simple_error
  1972.           ("Could not obtain mask image instance", lmask);
  1973.           if (XIMAGE_INSTANCE_PIXMAP_DEPTH (lmask) != 0)
  1974.         signal_simple_error_2 ("mask must be 1 bit deep",
  1975.                        mask_file, lmask);
  1976.           mask = XIMAGE_INSTANCE_X_PIXMAP (lmask);
  1977.           mask_file = Qnil;
  1978.         }
  1979.     }
  1980.  
  1981.       check_pointer_sizes (xs,
  1982.                XIMAGE_INSTANCE_PIXMAP_WIDTH (lsource),
  1983.                XIMAGE_INSTANCE_PIXMAP_HEIGHT (lsource),
  1984.                name, 0);
  1985.  
  1986.       /* If the loaded pixmap has colors allocated (meaning it came from an
  1987.      XPM file), then use those as the default colors for the cursor we
  1988.      create.  Otherwise, default to black and white.
  1989.        */
  1990.       if (XIMAGE_INSTANCE_X_NPIXELS (lsource) >= 2)
  1991.     {
  1992.       int npixels = XIMAGE_INSTANCE_X_NPIXELS (lsource);
  1993.       unsigned long *pixels = XIMAGE_INSTANCE_X_PIXELS (lsource);
  1994.  
  1995.       /* With an XBM file, it's obvious which bit is foreground and which
  1996.          is background, or rather, it's implicit: in an XBM file, a 1 bit
  1997.          is foreground, and a 0 bit is background.
  1998.  
  1999.          XCreatePixmapCursor() assumes this property of the pixmap it is
  2000.          called with as well; the `foreground' color argument is used for
  2001.          the 1 bits.
  2002.  
  2003.          With an XPM file, it's tricker, since the elements of the pixmap
  2004.          don't represent FG and BG, but are actual pixel values.  So we
  2005.          need to figure out which of those pixels is the foreground color
  2006.          and which is the background.  We do it by comparing RGB and
  2007.          assuming that the darker color is the foreground.  This works
  2008.          with the result of xbmtopbm|ppmtoxpm, at least.
  2009.  
  2010.          It might be nice if there was some way to tag the colors in the
  2011.          XPM file with whether they are the foreground - perhaps with
  2012.          logical color names somehow?
  2013.  
  2014.          Once we have decided which color is the foreground, we need to
  2015.          ensure that that color corresponds to a `1' bit in the Pixmap.
  2016.          The XPM library wrote into the (1-bit) pixmap with XPutPixel,
  2017.          which will ignore all but the least significant bit.
  2018.  
  2019.          This means that a 1 bit in the image corresponds to `fg' only if
  2020.          `fg.pixel' is odd.
  2021.  
  2022.          (This also means that the image will be all the same color if
  2023.          both `fg' and `bg' are odd or even, but we can safely assume
  2024.          that that won't happen if the XPM file is sensible I think.)
  2025.  
  2026.          The desired result is that the image use `1' to represent the
  2027.          foreground color, and `0' to represent the background color.
  2028.          So, we may need to invert the image to accomplish this; we invert
  2029.          if fg is odd. (Remember that WhitePixel and BlackPixel are not
  2030.          necessarily 1 and 0 respectively, though I think it might be safe
  2031.          to assume that one of them is always 1 and the other is always 0.
  2032.          We also pretty much need to assume that one is even and the other
  2033.          is odd.)
  2034.        */
  2035.  
  2036.       fg.pixel = pixels [0];    /* pick a pixel at random. */
  2037.       bg.pixel = fg.pixel;
  2038.       for (i = 1; i < npixels; i++)    /* Look for an "other" pixel value. */
  2039.         {
  2040.           bg.pixel = pixels [i];
  2041.           if (fg.pixel != bg.pixel) break;
  2042.         }
  2043.  
  2044.       /* If (fg.pixel == bg.pixel) then probably something has gone wrong,
  2045.          but I don't think signalling an error would be appropriate. */
  2046.  
  2047.       XQueryColor (DisplayOfScreen(xs), DefaultColormapOfScreen(xs), &fg);
  2048.       XQueryColor (DisplayOfScreen(xs), DefaultColormapOfScreen(xs), &bg);
  2049.  
  2050.       /* If the foreground is lighter than the background, swap them.
  2051.          (This occurs semi-randomly, depending on the ordering of the
  2052.          color list in the XPM file.)
  2053.        */
  2054.       {
  2055.         unsigned short fg_total = ((fg.red / 3) + (fg.green / 3)
  2056.                        + (fg.blue / 3));
  2057.         unsigned short bg_total = ((bg.red / 3) + (bg.green / 3)
  2058.                        + (bg.blue / 3));
  2059.           if (fg_total > bg_total)
  2060.         {
  2061.           XColor swap;
  2062.           swap = fg;
  2063.           fg = bg;
  2064.           bg = swap;
  2065.         }
  2066.       }
  2067.  
  2068.       /* If the fg pixel corresponds to a `0' in the bitmap, invert it.
  2069.          (This occurs (only?) on servers with Black=0, White=1.)
  2070.        */
  2071.       if ((fg.pixel & 1) == 0)
  2072.         {
  2073.           XGCValues gcv;
  2074.           GC gc;
  2075.           gcv.function = GXxor;
  2076.           gcv.foreground = 1;
  2077.           gc = XCreateGC (dpy, source, (GCFunction | GCForeground), &gcv);
  2078.           XFillRectangle (dpy, source, gc, 0, 0,
  2079.                   XIMAGE_INSTANCE_PIXMAP_WIDTH (lsource),
  2080.                   XIMAGE_INSTANCE_PIXMAP_HEIGHT (lsource));
  2081.           XFreeGC (dpy, gc);
  2082.         }
  2083.     }
  2084.  
  2085.       cursor = XCreatePixmapCursor
  2086.     (dpy, source, mask, &fg, &bg,
  2087.      !NILP (XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (lsource)) ?
  2088.      XINT (XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (lsource)) : 0,
  2089.      !NILP (XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (lsource)) ?
  2090.      XINT (XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (lsource)) : 0);
  2091.       UNGCPRO; /* can now collect and free `lsource', `lmask', and Pixmaps. */
  2092.     }
  2093.   return cursor;
  2094. }
  2095.  
  2096. DEFUN ("make-cursor", Fmake_cursor, Smake_cursor, 1, 4, 0,
  2097.        "Creates a new `cursor' object of the specified name.\n\
  2098. The optional second and third arguments are the foreground and background\n\
  2099.  colors.  They may be color name strings or `pixel' objects.\n\
  2100. The optional fourth argument is the device on which to allocate the cursor\n\
  2101.  (defaults to the selected device).\n\
  2102. This allocates a new cursor in the X server, and signals an error if the\n\
  2103.  cursor is unknown or cannot be allocated.\n\
  2104. \n\
  2105. A cursor name can take many different forms.  It can be:\n\
  2106.  - any of the standard cursor names from appendix B of the Xlib manual\n\
  2107.    (also known as the file <X11/cursorfont.h>) minus the XC_ prefix;\n\
  2108.  - the name of a font, and glyph index into it of the form\n\
  2109.    \"FONT fontname index [[mask-font] mask-index]\";\n\
  2110.  - the name of a bitmap or pixmap file;\n\
  2111.  - or an image instance object, as returned by `make-image-instance'.\n\
  2112. \n\
  2113. If it is an image instance or pixmap file, and that pixmap comes with a\n\
  2114.  mask, then that mask will be used.  If it is an image instance, it must\n\
  2115.  have only one plane, since X cursors may only have two colors.  If it is a\n\
  2116.  pixmap file, then the file will be read in monochrome.\n\
  2117. \n\
  2118. If it is a bitmap file, and if a bitmap file whose name is the name of the\n\
  2119.  cursor with \"msk\" or \"Mask\" appended exists, then that second bitmap\n\
  2120.  will be used as the mask.  For example, a pair of files might be named\n\
  2121.  \"cursor.xbm\" and \"cursor.xbmmsk\".\n\
  2122. \n\
  2123. The returned object is a normal, first-class lisp object.  The way you\n\
  2124. `deallocate' the cursor is the way you deallocate any other lisp object:\n\
  2125. you drop all pointers to it and allow it to be garbage collected.  When\n\
  2126. these objects are GCed, the underlying X data is deallocated as well.")
  2127.   (name, fg, bg, device)
  2128.   Lisp_Object name, fg, bg, device;
  2129. {
  2130.   /* This function can GC */
  2131.   Screen *xs;
  2132.   Cursor cursor;
  2133.  
  2134.   XSETDEVICE (device, get_x_device (device));
  2135.   xs = LISP_DEVICE_TO_X_SCREEN (device);
  2136.  
  2137.   if ((NILP (fg)) != (NILP (bg)))
  2138.     error ("must specify both foreground and background, or neither.");
  2139.  
  2140.   if (STRINGP (fg))
  2141.     fg = Fmake_color_instance (fg, device, Qnil);
  2142.   else if (!NILP (fg) && !COLOR_INSTANCEP (fg))
  2143.     CHECK_STRING (fg, 0);
  2144.  
  2145.   if (STRINGP (bg))
  2146.     bg = Fmake_color_instance (bg, device, Qnil);
  2147.   else if (!NILP (bg) && !COLOR_INSTANCEP (bg))
  2148.     CHECK_STRING (bg, 0);
  2149.  
  2150.   cursor = make_cursor_1 (device, name);
  2151.  
  2152.   if (! cursor)
  2153.     signal_simple_error ("unknown cursor", name);
  2154.  
  2155.   /* Got the cursor, now color it in.
  2156.      (Either both are specified or neither.) */
  2157.   if (!NILP (fg))
  2158.     {
  2159.       XColor xbg, xfg;
  2160.  
  2161.       xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (bg));
  2162.       xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (fg));
  2163.  
  2164.       XRecolorCursor (DisplayOfScreen (xs), cursor,
  2165.               &xfg, &xbg);
  2166.     }
  2167.   
  2168.   /* Now make the lisp object. */
  2169.   {
  2170.     struct Lisp_Cursor *c = alloc_lcrecord (sizeof (struct Lisp_Cursor),
  2171.                         lrecord_cursor);
  2172.     Lisp_Object val;
  2173.     c->device = device;
  2174.     c->name = name;
  2175.     c->cursor = cursor;
  2176.     c->fg = fg;
  2177.     c->bg = bg;
  2178.     XSETCURSOR (val, c);
  2179.     return val;
  2180.   }
  2181. }
  2182.  
  2183. DEFUN ("cursorp", Fcursorp, Scursorp, 1, 1, 0,
  2184.        "Return non-nil if OBJECT is a cursor.")
  2185.   (object)
  2186.   Lisp_Object object;
  2187. {
  2188.   return (CURSORP (object) ? Qt : Qnil);
  2189. }
  2190.  
  2191. DEFUN ("cursor-name", Fcursor_name, Scursor_name, 1, 1, 0,
  2192.        "Return the name used to allocate the given cursor.")
  2193.   (cursor)
  2194.   Lisp_Object cursor;
  2195. {
  2196.   CHECK_CURSOR (cursor, 0);
  2197.   return (XCURSOR (cursor)->name);
  2198. }
  2199.  
  2200. DEFUN ("cursor-foreground", Fcursor_foreground, Scursor_foreground, 1, 1, 0,
  2201.    "Return the foreground color of the given cursor, or nil if unspecified.")
  2202.   (cursor)
  2203.   Lisp_Object cursor;
  2204. {
  2205.   CHECK_CURSOR (cursor, 0);
  2206.   return (XCURSOR (cursor)->fg);
  2207. }
  2208.  
  2209. DEFUN ("cursor-background", Fcursor_background, Scursor_background, 1, 1, 0,
  2210.    "Return the background color of the given cursor, or nil if unspecified.")
  2211.   (cursor)
  2212.   Lisp_Object cursor;
  2213. {
  2214.   CHECK_CURSOR (cursor, 0);
  2215.   return (XCURSOR (cursor)->bg);
  2216. }
  2217.  
  2218.  
  2219. /************************************************************************/
  2220. /*                               subwindows                             */
  2221. /************************************************************************/
  2222.  
  2223. Lisp_Object Qsubwindowp;
  2224. static Lisp_Object mark_subwindow (Lisp_Object, void (*) (Lisp_Object));
  2225. static void print_subwindow (Lisp_Object, Lisp_Object, int);
  2226. static void finalize_subwindow (void *, int);
  2227. static int subwindow_equal (Lisp_Object o1, Lisp_Object o2, int depth);
  2228. static unsigned long subwindow_hash (Lisp_Object obj, int depth);
  2229. DEFINE_LRECORD_IMPLEMENTATION ("subwindow", subwindow,
  2230.                    mark_subwindow, print_subwindow,
  2231.                    finalize_subwindow, subwindow_equal,
  2232.                    subwindow_hash, struct Lisp_Subwindow);
  2233.  
  2234. static Lisp_Object
  2235. mark_subwindow (Lisp_Object obj, void (*markobj) (Lisp_Object))
  2236. {
  2237.   struct Lisp_Subwindow *sw = XSUBWINDOW (obj);
  2238.   return sw->frame;
  2239. }
  2240.  
  2241. static void
  2242. print_subwindow (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
  2243. {
  2244.   char buf[100];
  2245.   struct Lisp_Subwindow *sw = XSUBWINDOW (obj);
  2246.   struct frame *frm = XFRAME (sw->frame);
  2247.  
  2248.   if (print_readably)
  2249.     error ("printing unreadable object #<subwindow 0x%x>",
  2250.        sw->header.uid);
  2251.  
  2252.   write_c_string ("#<subwindow", printcharfun);
  2253.   sprintf (buf, " %dx%d", sw->width, sw->height);
  2254.   write_c_string (buf, printcharfun);
  2255.  
  2256.   /* This is stolen from frame.c.  Subwindows are strange in that they
  2257.      are specific to a particular frame so we want to print in their
  2258.      description what that frame is. */
  2259.   
  2260.   write_c_string (" on #<", printcharfun);
  2261.   if (!FRAME_LIVE_P (frm))
  2262.     write_c_string ("dead", printcharfun);
  2263.   else if (FRAME_IS_TTY (frm))
  2264.     write_c_string ("tty", printcharfun);
  2265.   else if (FRAME_IS_X (frm))
  2266.     write_c_string ("x", printcharfun);
  2267.   else
  2268.     write_c_string ("UNKNOWN", printcharfun);
  2269.   write_c_string ("-frame ", printcharfun);
  2270.   print_internal (frm->name, printcharfun, 1);
  2271.   sprintf (buf, " 0x%x>", frm->header.uid);
  2272.   write_c_string (buf, printcharfun);
  2273.  
  2274.   sprintf (buf, ") 0x%x>", sw->header.uid);
  2275.   write_c_string (buf, printcharfun);
  2276. }
  2277.  
  2278. static void
  2279. finalize_subwindow (void *header, int for_disksave)
  2280. {
  2281.   struct Lisp_Subwindow *sw = (struct Lisp_Subwindow *) header;
  2282.   if (for_disksave) finalose (sw);
  2283.   if (sw->subwindow)
  2284.     {
  2285.       XDestroyWindow (DisplayOfScreen (sw->xscreen), sw->subwindow);
  2286.       sw->subwindow = 0;
  2287.     }
  2288. }
  2289.  
  2290. /* subwindows are equal iff they have the same window XID */
  2291. static int
  2292. subwindow_equal (Lisp_Object o1, Lisp_Object o2, int depth)
  2293. {
  2294.   return (XSUBWINDOW (o1)->subwindow == XSUBWINDOW (o2)->subwindow);
  2295. }
  2296.  
  2297. static unsigned long
  2298. subwindow_hash (Lisp_Object obj, int depth)
  2299. {
  2300.   return XSUBWINDOW (obj)->subwindow;
  2301. }
  2302.  
  2303. /* #### PROBLEM: The display routines assume that the glyph is only
  2304.  being displayed in one buffer.  If it is in two different buffers
  2305.  which are both being displayed simultaneously you will lose big time.
  2306.  This can be dealt with in the new redisplay. */
  2307.  
  2308. /* #### These are completely un-re-implemented in 19.13.  Get it done
  2309.    for 19.14. */
  2310.  
  2311. DEFUN ("make-subwindow", Fmake_subwindow, Smake_subwindow,
  2312.        0, 3, 0,
  2313.        "Creates a new `x-window' object of size WIDTH x HEIGHT.\n\
  2314. The default is a window of size 1x1, which is also the minimum allowed\n\
  2315. window size.  Subwindows are per-frame.  A buffer being shown in two\n\
  2316. different frames will only display a subwindow glyph in the frame in\n\
  2317. which it was actually created.  If two windows on the same frame are\n\
  2318. displaying the buffer then the most recently used window will actually\n\
  2319. display the window.  If the frame is not specified, the selected frame\n\
  2320. is used.")
  2321.   (width, height, frame)
  2322.   Lisp_Object width, height, frame;
  2323. {
  2324.   Display *dpy;
  2325.   Screen *xs;
  2326.   Window pw;
  2327.   struct frame *f;
  2328.   unsigned int iw, ih;
  2329.   XSetWindowAttributes xswa;
  2330.   Mask valueMask = 0;
  2331.  
  2332.   error ("subwindows are not functional in 19.13; they will be in 19.14");
  2333.  
  2334.   f = get_x_frame (frame);
  2335.  
  2336.   xs = LISP_DEVICE_TO_X_SCREEN (FRAME_DEVICE (f));
  2337.   dpy = DisplayOfScreen (xs);
  2338.   pw = XtWindow (FRAME_X_TEXT_WIDGET (f));
  2339.  
  2340.   if (NILP (width))
  2341.     iw = 1;
  2342.   else
  2343.     {
  2344.       CHECK_INT (width, 0);
  2345.       iw = XINT (width);
  2346.       if (iw < 1) iw = 1;
  2347.     }
  2348.   if (NILP (height))
  2349.     ih = 1;
  2350.   else
  2351.     {
  2352.       CHECK_INT (height, 0);
  2353.       ih = XINT (height);
  2354.       if (ih < 1) ih = 1;
  2355.     }
  2356.  
  2357.   {
  2358.     struct Lisp_Subwindow *sw = alloc_lcrecord (sizeof (struct Lisp_Subwindow),
  2359.                         lrecord_subwindow);
  2360.     Lisp_Object val;
  2361.     sw->frame = frame;
  2362.     sw->xscreen = xs;
  2363.     sw->parent_window = pw;
  2364.     sw->height = ih;
  2365.     sw->width = iw;
  2366.  
  2367.     xswa.backing_store = Always;
  2368.     valueMask |= CWBackingStore;
  2369.  
  2370.     xswa.colormap = DefaultColormapOfScreen (xs);
  2371.     valueMask |= CWColormap;
  2372.  
  2373.     sw->subwindow = XCreateWindow (dpy, pw, 0, 0, iw, ih, 0, CopyFromParent,
  2374.                    InputOutput, CopyFromParent, valueMask,
  2375.                    &xswa);
  2376.  
  2377.     XSETSUBWINDOW (val, sw);
  2378.     return val;
  2379.   }
  2380. }
  2381.  
  2382. /* #### Should this function exist? */
  2383. DEFUN ("change-subwindow-property", Fchange_subwindow_property,
  2384.        Schange_subwindow_property, 3, 3, 0,
  2385.        "For the given SUBWINDOW, set PROPERTY to DATA, which is a string.")
  2386.   (subwindow, property, data)
  2387.   Lisp_Object subwindow, property, data;
  2388. {
  2389.   Atom property_atom;
  2390.   struct Lisp_Subwindow *sw;
  2391.   Display *dpy;
  2392.  
  2393.   CHECK_SUBWINDOW (subwindow, 0);
  2394.   CHECK_STRING (property, 0);
  2395.   CHECK_STRING (data, 0);
  2396.  
  2397.   sw = XSUBWINDOW (subwindow);
  2398.   dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN
  2399.              (FRAME_DEVICE (XFRAME (sw->frame))));
  2400.  
  2401.   property_atom = XInternAtom (dpy, (char *) string_data (XSTRING (property)),
  2402.                    False);
  2403.   XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8,
  2404.            PropModeReplace, string_data (XSTRING (data)),
  2405.            string_length (XSTRING (data)));
  2406.  
  2407.   return (property);
  2408. }
  2409.  
  2410. DEFUN ("subwindowp", Fsubwindowp, Ssubwindowp, 1, 1, 0,
  2411.        "Return non-nil if OBJECT is a subwindow.")
  2412.   (object)
  2413.   Lisp_Object object;
  2414. {
  2415.   return (SUBWINDOWP (object) ? Qt : Qnil);
  2416. }
  2417.  
  2418. DEFUN ("subwindow-width", Fsubwindow_width, Ssubwindow_width,
  2419.        1, 1, 0,
  2420.        "Width of SUBWINDOW.")
  2421.   (subwindow)
  2422.   Lisp_Object subwindow;
  2423. {
  2424.   CHECK_SUBWINDOW (subwindow, 0);
  2425.   return (make_number (XSUBWINDOW (subwindow)->width));
  2426. }
  2427.  
  2428. DEFUN ("subwindow-height", Fsubwindow_height, Ssubwindow_height,
  2429.        1, 1, 0,
  2430.        "Height of SUBWINDOW.")
  2431.   (subwindow)
  2432.   Lisp_Object subwindow;
  2433. {
  2434.   CHECK_SUBWINDOW (subwindow, 0);
  2435.   return (make_number (XSUBWINDOW (subwindow)->height));
  2436. }
  2437.  
  2438. DEFUN ("subwindow-xid", Fsubwindow_xid, Ssubwindow_xid, 1, 1, 0,
  2439.        "Return the xid of SUBWINDOW as a number.")
  2440.   (subwindow)
  2441.   Lisp_Object subwindow;
  2442. {
  2443.   CHECK_SUBWINDOW (subwindow, 0);
  2444.   return (make_number (XSUBWINDOW (subwindow)->subwindow));
  2445. }
  2446.  
  2447. DEFUN ("resize-subwindow", Fresize_subwindow, Sresize_subwindow,
  2448.        1, 3, 0,
  2449.   "Resize SUBWINDOW to WIDTH x HEIGHT.\n\
  2450. If a value is nil that parameter is not changed.")
  2451.   (subwindow, width, height)
  2452.   Lisp_Object subwindow, width, height;
  2453. {
  2454.   int neww, newh;
  2455.   struct Lisp_Subwindow *sw;
  2456.  
  2457.   CHECK_SUBWINDOW (subwindow, 0);
  2458.   sw = XSUBWINDOW (subwindow);
  2459.  
  2460.   if (NILP (width))
  2461.     neww = sw->width;
  2462.   else
  2463.     neww = XINT (width);
  2464.  
  2465.   if (NILP (height))
  2466.     newh = sw->height;
  2467.   else
  2468.     newh = XINT (height);
  2469.  
  2470.   XResizeWindow (DisplayOfScreen (sw->xscreen), sw->subwindow, neww, newh);
  2471.  
  2472.   sw->height = newh;
  2473.   sw->width = neww;
  2474.  
  2475.   return subwindow;
  2476. }
  2477.  
  2478. DEFUN ("force-subwindow-map", Fforce_subwindow_map,
  2479.        Sforce_subwindow_map, 1, 1, 0,
  2480.   "Generate a Map event for SUBWINDOW.")
  2481.      (subwindow)
  2482.      Lisp_Object subwindow;
  2483. {
  2484.   CHECK_SUBWINDOW (subwindow, 0);
  2485.  
  2486.   XMapWindow (DisplayOfScreen (XSUBWINDOW (subwindow)->xscreen),
  2487.           XSUBWINDOW (subwindow)->subwindow);
  2488.  
  2489.   return subwindow;
  2490. }
  2491.  
  2492.  
  2493. /************************************************************************/
  2494. /*                            initialization                            */
  2495. /************************************************************************/
  2496.  
  2497. void
  2498. syms_of_glyphs_x (void)
  2499. {
  2500.   defsymbol (&Qcursorp, "cursorp");
  2501.   defsubr (&Smake_cursor);
  2502.   defsubr (&Scursorp);
  2503.   defsubr (&Scursor_name);
  2504.   defsubr (&Scursor_foreground);
  2505.   defsubr (&Scursor_background);
  2506.  
  2507.   defsubr (&Scolorize_image_instance);
  2508.  
  2509.   defsymbol (&Qsubwindowp, "subwindowp");
  2510.   defsubr (&Smake_subwindow);
  2511.   defsubr (&Schange_subwindow_property);
  2512.   defsubr (&Ssubwindowp);
  2513.   defsubr (&Ssubwindow_width);
  2514.   defsubr (&Ssubwindow_height);
  2515.   defsubr (&Ssubwindow_xid);
  2516.   defsubr (&Sresize_subwindow);
  2517.   defsubr (&Sforce_subwindow_map);
  2518.  
  2519.   defkeyword (&Q_mask_file, ":mask-file");
  2520.   defkeyword (&Q_mask_data, ":mask-data");
  2521.   defkeyword (&Q_hotspot_x, ":hotspot-x");
  2522.   defkeyword (&Q_hotspot_y, ":hotspot-y");
  2523.   defkeyword (&Q_foreground, ":foreground");
  2524.   defkeyword (&Q_background, ":background");
  2525.  
  2526. #ifdef HAVE_XPM
  2527.   defkeyword (&Q_color_symbols, ":color-symbols");
  2528. #endif
  2529. }
  2530.  
  2531. void
  2532. device_type_create_glyphs_x (void)
  2533. {
  2534.   /* image methods */
  2535.  
  2536.   DEVICE_HAS_METHOD (x, print_image_instance);
  2537.   DEVICE_HAS_METHOD (x, finalize_image_instance);
  2538.   DEVICE_HAS_METHOD (x, image_instance_equal);
  2539.   DEVICE_HAS_METHOD (x, image_instance_hash);
  2540. }
  2541.  
  2542. void
  2543. image_instantiator_type_create_glyphs_x (void)
  2544. {
  2545.   /* image-instantiator types */
  2546.  
  2547.   INITIALIZE_IMAGE_INSTANTIATOR_TYPE (xbm, "xbm");
  2548.  
  2549.   IITYPE_HAS_METHOD (xbm, validate);
  2550.   IITYPE_HAS_METHOD (xbm, normalize);
  2551.   IITYPE_HAS_METHOD (xbm, instantiate);
  2552.  
  2553.   IITYPE_VALID_KEYWORD (xbm, Q_data, valid_xbm_inline_p);
  2554.   IITYPE_VALID_KEYWORD (xbm, Q_file, valid_string_p);
  2555.   IITYPE_VALID_KEYWORD (xbm, Q_mask_data, valid_xbm_inline_p);
  2556.   IITYPE_VALID_KEYWORD (xbm, Q_mask_file, valid_string_p);
  2557.   IITYPE_VALID_KEYWORD (xbm, Q_hotspot_x, valid_int_p);
  2558.   IITYPE_VALID_KEYWORD (xbm, Q_hotspot_y, valid_int_p);
  2559.   IITYPE_VALID_KEYWORD (xbm, Q_foreground, valid_string_p);
  2560.   IITYPE_VALID_KEYWORD (xbm, Q_background, valid_string_p);
  2561.  
  2562. #ifdef HAVE_JPEG
  2563.   INITIALIZE_IMAGE_INSTANTIATOR_TYPE (jpeg, "jpeg");
  2564.  
  2565.   IITYPE_HAS_METHOD (jpeg, validate);
  2566.   IITYPE_HAS_METHOD (jpeg, normalize);
  2567.   IITYPE_HAS_METHOD (jpeg, instantiate);
  2568.  
  2569.   IITYPE_VALID_KEYWORD (jpeg, Q_data, valid_string_p);
  2570.   IITYPE_VALID_KEYWORD (jpeg, Q_file, valid_string_p);
  2571. #endif
  2572.  
  2573. #ifdef HAVE_GIF
  2574.   INITIALIZE_IMAGE_INSTANTIATOR_TYPE (gif, "gif");
  2575.  
  2576.   IITYPE_HAS_METHOD (gif, validate);
  2577.   IITYPE_HAS_METHOD (gif, normalize);
  2578.   IITYPE_HAS_METHOD (gif, instantiate);
  2579.  
  2580.   IITYPE_VALID_KEYWORD (gif, Q_data, valid_string_p);
  2581.   IITYPE_VALID_KEYWORD (gif, Q_file, valid_string_p);
  2582. #endif
  2583.  
  2584. #ifdef HAVE_PNG
  2585.   INITIALIZE_IMAGE_INSTANTIATOR_TYPE (png, "png");
  2586.  
  2587.   IITYPE_HAS_METHOD (png, validate);
  2588.   IITYPE_HAS_METHOD (png, normalize);
  2589.   IITYPE_HAS_METHOD (png, instantiate);
  2590.  
  2591.   IITYPE_VALID_KEYWORD (png, Q_data, valid_string_p);
  2592.   IITYPE_VALID_KEYWORD (png, Q_file, valid_string_p);
  2593. #endif
  2594.   
  2595. #ifdef HAVE_XPM
  2596.   INITIALIZE_IMAGE_INSTANTIATOR_TYPE (xpm, "xpm");
  2597.  
  2598.   IITYPE_HAS_METHOD (xpm, validate);
  2599.   IITYPE_HAS_METHOD (xpm, normalize);
  2600.   IITYPE_HAS_METHOD (xpm, instantiate);
  2601.  
  2602.   IITYPE_VALID_KEYWORD (xpm, Q_data, valid_string_p);
  2603.   IITYPE_VALID_KEYWORD (xpm, Q_file, valid_string_p);
  2604.   IITYPE_VALID_KEYWORD (xpm, Q_color_symbols, valid_xpm_color_symbols_p);
  2605. #endif
  2606.  
  2607. #ifdef HAVE_XFACE
  2608.   INITIALIZE_IMAGE_INSTANTIATOR_TYPE (xface, "xface");
  2609.  
  2610.   IITYPE_HAS_METHOD (xface, validate);
  2611.   IITYPE_HAS_METHOD (xface, normalize);
  2612.   IITYPE_HAS_METHOD (xface, instantiate);
  2613.  
  2614.   IITYPE_VALID_KEYWORD (xface, Q_data, valid_string_p);
  2615.   IITYPE_VALID_KEYWORD (xface, Q_file, valid_string_p);
  2616.   IITYPE_VALID_KEYWORD (xface, Q_hotspot_x, valid_int_p);
  2617.   IITYPE_VALID_KEYWORD (xface, Q_hotspot_y, valid_int_p);
  2618.   IITYPE_VALID_KEYWORD (xface, Q_foreground, valid_string_p);
  2619.   IITYPE_VALID_KEYWORD (xface, Q_background, valid_string_p);
  2620. #endif 
  2621.  
  2622.   INITIALIZE_IMAGE_INSTANTIATOR_TYPE (autodetect, "autodetect");
  2623.  
  2624.   IITYPE_HAS_METHOD (autodetect, validate);
  2625.   IITYPE_HAS_METHOD (autodetect, normalize);
  2626.   IITYPE_HAS_METHOD (autodetect, instantiate);
  2627.  
  2628.   IITYPE_VALID_KEYWORD (autodetect, Q_data, valid_string_p);
  2629. }
  2630.  
  2631. void
  2632. vars_of_glyphs_x (void)
  2633. {
  2634. #ifdef HAVE_JPEG
  2635.   Fprovide (Qjpeg);
  2636. #endif
  2637.  
  2638. #ifdef HAVE_GIF
  2639.   Fprovide (Qgif);
  2640. #endif
  2641.  
  2642. #ifdef HAVE_PNG
  2643.   Fprovide (Qpng);
  2644. #endif
  2645.   
  2646. #ifdef HAVE_XPM
  2647.   Fprovide (Qxpm);
  2648.  
  2649.   DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols,
  2650.        "Definitions of logical color-names used when reading XPM files.\n\
  2651. Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).\n\
  2652. The COLOR-NAME should be a string, which is the name of the color to define;\n\
  2653. the FORM should evaluate to a `color' specifier object, or a string to be\n\
  2654. passed to `make-color-instance'.  If a loaded XPM file references a symbolic\n\
  2655. color called COLOR-NAME, it will display as the computed color instead.\n\
  2656. \n\
  2657. The default value of this variable defines the logical color names\n\
  2658. \"foreground\" and \"background\" to be the colors of the `default' face.");
  2659.   Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
  2660. #endif 
  2661.  
  2662. #ifdef HAVE_XFACE
  2663.   Fprovide (Qxface);
  2664. #endif 
  2665.  
  2666.   DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
  2667.        "A list of the directories in which X bitmap files may be found.\n\
  2668. If nil, this is initialized from the \"*bitmapFilePath\" resource.\n\
  2669. This is used by the `make-image-instance' function (however, note that if\n\
  2670. the environment variable XBMLANGPATH is set, it is consulted first).");
  2671.   Vx_bitmap_file_path = Qnil;
  2672. }
  2673.  
  2674. void
  2675. complex_vars_of_glyphs_x (void)
  2676. {
  2677. #define BUILD_GLYPH_INST(variable, name)            \
  2678.   Fadd_spec_to_specifier                    \
  2679.     (GLYPH_IMAGE (XGLYPH (variable)),                \
  2680.      vector3 (Qxbm, Q_data,                    \
  2681.           list3 (make_number (name##_width),        \
  2682.              make_number (name##_height),        \
  2683.              make_ext_string ((char *) name##_bits,    \
  2684.                       sizeof (name##_bits)))),    \
  2685.      Qglobal, Qx, Qnil)
  2686.  
  2687.   BUILD_GLYPH_INST (Vtruncation_glyph, truncator);
  2688.   BUILD_GLYPH_INST (Vcontinuation_glyph, continuer);
  2689.   BUILD_GLYPH_INST (Vxemacs_logo, xemacs);
  2690.  
  2691. #undef BUILD_GLYPH_INST
  2692. }
  2693.  
  2694.